﻿/// /////////////////////////////////////////////
// 单元名 : unitMisc
// 作者 : Hawk
// 单元描述 : 杂项单元
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit unitMisc;

interface

{$Q-}
{$R-}

uses
  Types, unitCommonTypes, SysUtils, DateUtils, IOUtils, {$IFDEF FPC}base64, MD5{$ELSE}Hash{$ENDIF}
  {$IFDEF MSWINDOWS}, Windows, ShellApi,
  {$IFDEF FPC}jwaiphlpapi, JwaWinNT, jwaipTypes{$ELSE}Messages, Iphlpapi, iptypes{$ENDIF},
  unitSetupAPI, WinSock2, unitWinAPI
  {$ENDIF}
  {$IFDEF ANDROID}
  , Androidapi.Helpers, Androidapi.Log, Androidapi.AppGlue, Androidapi.JNI.App, System.NetEncoding
  {$ENDIF}
  {$IFDEF LINUX}, netdb, linux, BaseUnix{$ENDIF};

const
  L_DBGMASK_NET = $80;

  L_DBGLEVEL_DEBUG = 1;
  L_DBGLEVEL_RUNTIMEINFO = 2;
  L_DBGLEVEL_OUTPUT = $4000;
  L_DBGLEVEL_CRITICAL = $8000;
  {$IFDEF DEBUG}
  L_DBGMASK_MATCH: Longword = $FFFF;
  {$ELSE}
  L_DBGMASK_MATCH: longword = L_DBGLEVEL_CRITICAL + L_DBGLEVEL_OUTPUT + L_DBGLEVEL_RUNTIMEINFO + L_DBGLEVEL_DEBUG;
  {$ENDIF}
  C_NUMBER: array [0 .. 9] of commonchar = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9');
  C_HEX_NUMBER: array [0 .. 11] of commonchar = ('A', 'B', 'C', 'D', 'E', 'F', 'a', 'b', 'c', 'd', 'e', 'f');
  S_BOOL: array [boolean] of CommonString = ('否', '是');
  S_SUCCESS: array [boolean] of CommonString = ('失败', '成功');
  S_SWITCH_ON_LOW = 'on';
  S_SWITCH_ON = 'On';
  S_SWITCH_OFF = 'Off';
  S_CRLF = #$D#$A;

  // Clipboard format
  CF_FILECONTENTS = 49271;
  CF_FILEGROUPDESCRIPTORW = 49339;
  CF_HTML_FORMAT = 49343;
  CF_DRAGCONTEXT = 49350;
  CF_UNIFORMRESOURCELOCATORW = 49355;
  CF_TEXT_HTML = 49485;
  CF_DRAGIMAGEBITS = 49907;
  CF_TEXT_X_MOZ_URL = 49948;
  CF_CHROMIUM_X_RENDERER_TAINT = 49949;

  CF_KINGSOFT_SHAPES_TAG = 49979;
  CF_ET_EMBEDED_PIC_FORMAT = 49984;
  CF_KINGSOFT_DATA_DESCRIPTOR = 49992;
  CF_KINGSOFT_WPS_9_0_Format = 49994;

  CF_ART_GVML_CLIPFORMAT = 50016;
  CF_KINGSOFT_IMAGE_DATA = 50029;
  CF_WPS_DRAWING_SHAPE_FORMAT = 50042;

const
  S_CHARSET = ['a' .. 'z', 'A' .. 'Z', '_'];
  S_SYMBOLSET = ['`', '~', '!', '@', '#', '$', '%', '^', '&', '*', '(', ')', '-', '_', '=',
    '+', '[', '{', ']', '}', '\', '|', ',', '<', '.', '>', '/', '?', ':', '''', '"', ';'];
  S_NUMBERSET = ['0' .. '9', 'x', 'X', 'a' .. 'f', 'A' .. 'F'];
  CLSID_BMP: TGUID = '{557CF400-1A04-11D3-9A73-0000F81EF32E}';
  CLSID_JPEG: TGUID = '{557CF401-1A04-11D3-9A73-0000F81EF32E}';
  CLSID_GIF: TGUID = '{557CF402-1A04-11D3-9A73-0000F81EF32E}';
  CLSID_TIFF: TGUID = '{557CF405-1A04-11D3-9A73-0000F81EF32E}';
  CLSID_PNG: TGUID = '{557CF406-1A04-11D3-9A73-0000F81EF32E}';
  {$IFDEF MSWINDOWS}
  {$IFDEF FPC}
  advapi32 = 'advapi32.dll';
  {$ENDIF}
{$ENDIF}

type
  TOnDbgPrintCB = procedure(DbgStr: CommonString; DbgLevel: longword) of object;

  TCPUID = array [1 .. 4] of longint;

  TCallBackForEnum = procedure(Name: CommonString) of object;

  TDEV_VIDPID = record
    vid, pid: longword;
  end;

  TCHECK_VIDPIDS = array of TDEV_VIDPID;

  TDOUBLE_LONGWORD = packed record
    case integer of
      0: (LowWord: longword;
        HighInt: integer);
      1: (V64: int64);
      2: (Words: array [0 .. 3] of word);
      3: (Bytes: array [0 .. 7] of byte);
  end;

  TCODETYPE = (ctUnknown, ctCharSet, ctNumber, ctSymbolSet);
  TDIVTYPE = (dtUnknown, dtInterval, dtDiffType, dtLineEnd);
  // 分割依据：未知，分隔符（空格或者分段），不同字符类型（先读取到数字，再遇到字母或者符号），行尾
  //TStrArr = array of CommonString;
  TTableData = array of array of CommonString;

  TNETCARDINFO = record
    Name, Desc: CommonString;
    IPV4: longword;
  end;

  TNETCARDINFOS = array of TNETCARDINFO;

  TSTR_TYPE = (stUnknown, stURI, stURL);

{$IFDEF MSWINDOWS}
{$IFDEF FPC}
function ConvertSidToStringSid(Sid: PSID; var StringSid: PAnsiChar): BOOL; stdcall;
  external advapi32 name 'ConvertSidToStringSidA';
{$ENDIF}
procedure CreateRegKeyValue(Root: nativeuint; const Key, ValueName: unicodestring; Value: integer); overload;
procedure CreateRegKeyValue(Root: nativeuint; const Key, ValueName, Value: unicodestring;
  KeyType: longword = REG_SZ); overload;
procedure GetRegKeyValue(Root: nativeuint; const Key, ValueName: unicodestring; var Value: integer); overload;
function GetRegKeyValue(Root: nativeuint; const Key, ValueName: unicodestring): unicodestring; overload;
procedure CreateRegKey(const Key, ValueName, Value: unicodestring; RootKey: nativeuint = HKEY_LOCAL_MACHINE);
procedure DelRegKey(Root: nativeuint; Key: unicodestring);
function RegEnumKeys(Root: nativeuint; Key: unicodestring): unicodestring;
function SaveResource(rName, rType, FileName: unicodestring): boolean;
function GetFileIcon(FileName: unicodestring = ''): THandle;
procedure StartTrayIcon(Main: THandle; Icon: hIcon; Tip: unicodestring);
procedure ChangeTrayIcon(Main: THandle; Icon: hIcon; Tip: unicodestring);
procedure ShowTrayBubble(Main: THandle; Title, Bubble: unicodestring);
procedure StopTrayIcon(Main: THandle);
procedure ShowMessage(Wnd: THandle; Message, Title: unicodestring);
{$ENDIF}
procedure DbgPrint(FormatStr: CommonString; args: array of const; dbglvl: longword = L_DBGLEVEL_DEBUG); overload;
procedure DbgPrint(Str: CommonString; dbglvl: longword = L_DBGLEVEL_DEBUG); overload;
procedure DbgPrintSysError(Str: CommonString);
procedure OutputSysErr(Oper: CommonString);

function ModuleFilePath: CommonString;
function ModuleFileName: CommonString;
function GetProcessAccountNameByID(pid: longword): CommonString; overload;
function GetProcessAccountName(hpproc: THandle): CommonString; overload;
{$IFDEF MSWINDOWS}
function SetFileSecurityToAll(FileName: CommonString): boolean;
function AnalyFileName(FullName: CommonString; var Driver: commonchar;
  var Path, MainName, ExtName: CommonString): boolean;
function CombineFileName(Driver: commonchar; Path, MainName, ExtName: CommonString): CommonString;
{$ENDIF}
function PathEqual(path1, path2: CommonString): boolean;
function PathIsFile(Path: CommonString): boolean;
function ExeFileName: CommonString;
function ExtractUpperPath(Path: CommonString): CommonString;
function TempPath: CommonString;
function IPToStr(ip: longword): CommonString;
function IPToStrB(ip: longword): CommonString;
function StrToIPV4(s: CommonString): longword;
function AddrtoIPV4(s: CommonString): longword;
procedure WStrPCopy(dst: pwidechar; s: unicodestring);
procedure CreatePath(Path: CommonString{$IFDEF MSWINDOWS}; FromChar: integer = 4{$ENDIF});
function BufToStr(const Buf; BufLen: integer): CommonString;
function HexToByte(hex: CommonString; var b: byte): boolean;
procedure StrToBuf(s: CommonString; var Buf; BufSize: longword);
function EnCodeStr(s: CommonString): CommonString;
function DeCodeStr(s: CommonString): CommonString;
function GetModuleVer(FileName: CommonString): TVER_INFO;
function GetFileSize(FileName: CommonString): TFILE_SIZE;
function VerToStr(v: TVER_INFO): CommonString;
function ExtraFileName(FullName: CommonString): CommonString;
function ExtractFileNameNoExt(FullName: CommonString): CommonString;
function ExtractFileMainName(FullName: CommonString): CommonString;
procedure DivFilePath(var Name: CommonString; var Path: CommonString);
procedure DivFileName(FullName: CommonString; var Path, Name: CommonString); overload;
procedure DivFileName(FullName: CommonString; var Path, MainName, ExtName: CommonString); overload;
procedure DelSpaceInStr(var s: CommonString);
function GetLine(var Buf: utf8string): utf8string; overload;
function GetLine(var Buf: ansistring): ansistring; overload;
function GetLine(var Buf: unicodestring): unicodestring; overload;
function GetLine(var Buf: pchar; MaxLen: integer): ansistring; overload;
function DivStrByTab(var s: CommonString): CommonString;
function DivStrByChar(s: CommonString; c: commonchar): TCommStrArr;
{$IFDEF MSWINDOWS}
function SysTimeToStr(const ft: TSYSTEMTIME): CommonString;
function FileExists(FileName: CommonString): boolean;
function IsPureFileName(FileName: CommonString): boolean;
procedure SaveWndToFile(Wnd: longword; FileName: CommonString = '');
function GetWndFromFile(FileName: CommonString = ''): longword;
function IsFullPath(s: CommonString): boolean;
function OSIsXP: boolean;
{$ENDIF}
function SizeToStr(size: int64): CommonString;
function SpeedToStr(speed: int64): CommonString;
procedure ExchangeExtName(var FileName: CommonString; Ext: CommonString);
function RightPos(SubStr, Str: CommonString): longword;
function StrToInteger(s: CommonString): integer; overload;
function StrToInteger64(s: CommonString): int64; overload;
function CashToStr(Cash: int64): CommonString;
function StrToCash(s: CommonString): int64;
function WideCharPos(WC: widechar; Str: unicodestring): integer;
function UpperCaseWideChar(WC: widechar): widechar;
function Min(N1, N2: integer): integer;
// function htons(p: Word): Word;
// function htonl(p: Longword): Longword;
function StrIsNumber(s: CommonString; CheckHex: boolean = False): boolean;
function GUIDIsEmpty(const g: TGUID): boolean;
procedure SaveStrToFile(FileName, Str: CommonString);
procedure SaveStrToFileA(FileName: CommonString; Str: ansistring);
function base64(Data: ansistring): CommonString;
function GetHash(Data: ansistring): THASH_VAL; overload;
function GetHash(var Data; Length: integer): THASH_VAL; overload;
function GetFileHash(FileName: CommonString; var FileSize: int64): THASH_VAL; overload;
function GetFileHash(F: THandle): THASH_VAL; overload;
{$IFDEF MSWINDOWS}
function IsX64: boolean;
procedure GetFileInfo(FileName: CommonString; var FileSize: TFILE_SIZE; var Hash: THASH_VAL; var ModTime: TFILETIME);
procedure ShutDownDevice(ShutDownOrReboot: boolean);
function CheckUSBDev(const chk: TCHECK_VIDPIDS): boolean;
function ExecProc(Cmd: CommonString; WaitTime: longword = INFINITE): longword;
procedure SetAutoStart(Name: CommonString; UserLevel: boolean = True);
function ClearOldVersion: boolean;
function GetDiskType(Disk: CommonString): longword;
{$ENDIF}
function DumpMem(const Mem; Len: integer; useSign: boolean = False): CommonString;
function LoadFile(FileName: CommonString): ansistring;
procedure SaveFile(FileName: CommonString; const Content; Len: longword);
function GetCurrentDateTimer: TMYTIME;
function IsGUIDEqual(const g1, g2: TGUID): boolean;
procedure EmptyGUID(var g: TGUID);
function DTToStr(dt: TDateTime): CommonString;
function StrToDT(s: CommonString): TDateTime;
function StrToDouble(s: CommonString): double;
procedure RegularRect(var R: TCommonRect);
function IsRectCross(const R1, R2: TCommonRect): boolean;
function SecondToDateStr(Sec: longword; Concise: boolean = False): CommonString;
procedure AdjustPath(var Path: CommonString);
procedure DelPath(Path: CommonString);
function GetFileModifyTime(FileName: CommonString): TFILETIME; overload;
function GetFileModifyDate(FileName: CommonString): longword; overload;
function FileSizeToStr(size: int64): CommonString;
function DateToDateStr(date: TDateTime): CommonString;
function FileTimeToStr(ft: TFILETIME): CommonString;
function Money2ChineseCapital2(const Num: double): CommonString;
function DevName: CommonString;
function IsSubPath(path1, path2: CommonString): boolean;
function DataToKMGP(d: int64): CommonString;
function CompareMem(P1, P2: Pointer; Len: longword): boolean;
function RegularExt(FileName: CommonString; ExpectExt: CommonString; ReservePath: boolean = False): CommonString;
function StrToDate(s: CommonString): TDateTime;
function IsExcelFile(ExtName: CommonString): boolean;
function AnsiTrim(s: ansistring): ansistring;
function AnsiLower(s: ansistring): ansistring;
function AnsiUpper(s: ansistring): ansistring;
function FetchStrFromCode(var s: CommonString; var ct: TCODETYPE; var dt: TDIVTYPE): CommonString;
function CurrentPath: CommonString;
function CheckIsChineseChar(s: CommonString): boolean;
function CheckIsID(s: CommonString): boolean;
function CheckIsMobileNum(s: CommonString): boolean;
function IsLeapYear(year: integer): boolean;
function UnicodeStrToUTF8(s: unicodestring): rawbytestring;
function UTF8StrToUnicode(s: rawbytestring): unicodestring;
function SecondToDT(Sec: longword): CommonString;
function RegularPath(s: CommonString): CommonString;
function RegularStr(s: CommonString): CommonString;
function DeleteComment(s: CommonString): CommonString;
//function GetCPUID: TCPUID;
function GenCPUSerialNo: CommonString;
function BufCheckSum(const Buf; Len: longword): longword;
function MoveFile(old, new: CommonString): longword;
function FileTimeToFileDate(ft: TFILETIME): longword;
function FileDateToFileTime(fd: longword): TFILETIME;
procedure ByteToHexStr(b: byte; P: PCommonChar);
procedure SetFileModTime(FileName: CommonString; mt: TFILETIME); overload;
procedure CreateMemFile(FileName: CommonString; size: longword; var Handle: THandle; var P: Pointer);
procedure OpenMemFile(FileName: CommonString; size: longword; var Handle: THandle; var P: Pointer);
procedure FreeMemFile(var Handle: THandle; var P: Pointer);
procedure GetNetCardInfos(var ni: TNETCARDINFOS);
function ReplaceParam(var s: CommonString; Name, Value: CommonString): integer;
function StringFromClipboardFormat(cf: word; AndNumber: boolean): CommonString;
function CheckStrType(s: CommonString; var Protocol, Domain, Port, Path, FileName: CommonString): TSTR_TYPE;

const
  {$IFDEF MSWINDOWS}
  MM_TRAYICONMSG = WM_APP + $100;
  {$ENDIF}
  COINIT_APARTMENTTHREADED = 2;
  COINIT_DISABLE_OLE1DDE = 4;
  BOOL_DISPNAME: array [False .. True] of CommonString = ('False', 'True');
  SAVEWND_FILENAME = 'wnd';
  HASHDATA_BUF_SIZE = 10 * 1024 * 1024;

  SEE_MASK_DEFAULT = $00000000;
  SEE_MASK_CLASSNAME = $00000001;
  SEE_MASK_CLASSKEY = $00000003;
  SEE_MASK_IDLIST = $00000004;
  SEE_MASK_INVOKEIDLIST = $0000000C;
  SEE_MASK_ICON = $00000010;
  SEE_MASK_HOTKEY = $00000020;
  SEE_MASK_NOCLOSEPROCESS = $00000040;
  SEE_MASK_CONNECTNETDRV = $00000080;
  SEE_MASK_NOASYNC = $00000100;
  SEE_MASK_FLAG_DDEWAIT = $00000100;
  SEE_MASK_DOENVSUBST = $00000200;
  SEE_MASK_FLAG_NO_UI = $00000400;
  SEE_MASK_UNICODE = $00004000;
  SEE_MASK_NO_CONSOLE = $00008000;
  SEE_MASK_ASYNCOK = $00100000;
  SEE_MASK_NOQUERYCLASSSTORE = $01000000;
  SEE_MASK_HMONITOR = $00200000;
  SEE_MASK_NOZONECHECKS = $00800000;
  SEE_MASK_WAITFORINPUTIDLE = $02000000;
  SEE_MASK_FLAG_LOG_USAGE = $04000000;

  // var
  // gOnDbgPrintCB: TOnDbgPrintCB;

implementation

var
  AppName, MDLName: CommonString;

  {$IFDEF MSWINDOWS}

const
  ID_TRAYICON = $1234;

function SaveResource(rName, rType, FileName: unicodestring): boolean;
var
  R: HRSRC;
  F: THandle;
  d: HGLOBAL;
  P: Pointer;
  l: longword;
begin
  Result := False;
  R := FindResourceW(0, pwidechar(rName), pwidechar(rType));
  if R <> 0 then
  begin
    d := LoadResource(0, R);
    if d <> 0 then
    begin
      P := LockResource(d);
      if P <> nil then
      begin
        l := SizeOfResource(0, R);
        F := FileCreate(FileName, fmOpenWrite);
        if F <> INVALID_HANDLE_VALUE then
        begin
          FileWrite(F, P^, l);
          Result := True;
          FileClose(F);
        end
        else
          DbgPrint('Save resource faile: %s', [SysErrorMessage(GetLastError)], L_DBGLEVEL_CRITICAL);
        UnlockResource(d);
      end;
    end
    else
      DbgPrint('Load resource faile: %s', [SysErrorMessage(GetLastError)], L_DBGLEVEL_CRITICAL);
  end;
end;

procedure CreateRegKey(const Key, ValueName, Value: unicodestring; RootKey: nativeuint = HKEY_LOCAL_MACHINE);
var
  Handle: HKEY;
  Status, Disposition: integer;
begin
  Status := RegCreateKeyExW(RootKey, pwidechar(Key), 0, '', REG_OPTION_NON_VOLATILE, KEY_READ or
    KEY_WRITE or WRITE_DAC or KEY_WOW64_64KEY, nil, Handle, @Disposition);
  if Status = 0 then
  begin
    // RegSetSecurity(Handle);
    if (Value <> '') and (Value[Length(Value)] = #0) then
      RegSetValueExW(Handle, pwidechar(ValueName), 0, REG_MULTI_SZ, pwidechar(Value), (Length(Value) + 1) * 2)
    else
      RegSetValueExW(Handle, pwidechar(ValueName), 0, REG_SZ, pwidechar(Value), (Length(Value) + 1) * 2);
    RegCloseKey(Handle);
  end;
end;

procedure DelRegKey(Root: nativeuint; Key: unicodestring);
var
  Handle: HKEY;
  Status, Disposition: integer;
  SubKeys, ss: unicodestring;
  i: integer;
  F: boolean;
begin
  SubKeys := RegEnumKeys(Root, Key);
  while SubKeys <> '' do
  begin
    ss := GetLine(SubKeys);
    DelRegKey(Root, Key + '\' + ss);
  end;
  if Key[Length(Key)] = '\' then
    System.Delete(Key, Length(Key), 1);
  ss := Key;
  F := False;
  for i := Length(Key) downto 1 do
    if Key[i] = '\' then
    begin
      ss := Copy(Key, i + 1, Length(Key));
      System.Delete(Key, i, Length(Key));
      F := True;
      Break;
    end;
  if not F then
    Key := '';
  if Key = '' then
  begin
    Handle := Root;
    Status := 0;
  end
  else
    Status := RegCreateKeyExW(Root, pwidechar(Key), 0, '', REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS or
      KEY_WOW64_64KEY, nil, Handle, @Disposition);
  if Status = 0 then
  begin
    RegDeleteKeyW(Handle, pwidechar(ss));
    RegCloseKey(Handle);
  end;
end;

function RegEnumKeys(Root: nativeuint; Key: unicodestring): unicodestring;
var
  Handle: HKEY;
  Status, Disposition, idx: integer;
  A: array [0 .. 255] of widechar;
  Len: longword;
begin
  Result := '';
  Status := RegCreateKeyExW(Root, pwidechar(Key), 0, '', REG_OPTION_NON_VOLATILE, KEY_READ or
    KEY_WOW64_64KEY, nil, Handle, @Disposition);
  if Status = 0 then
  begin
    // RegSetSecurity(Handle);
    idx := 0;
    Len := 255;
    while RegEnumKeyExW(Handle, idx, A, Len, nil, nil, nil, nil) = ERROR_SUCCESS do
    begin
      A[Len] := #0;
      Result := Result + A + #13;
      Len := 255;
      Inc(idx);
    end;
    RegCloseKey(Handle);
  end;
end;

procedure CreateRegKeyValue(Root: nativeuint; const Key, ValueName: unicodestring; Value: integer);
var
  Handle: HKEY;
  Status, Disposition: integer;
begin
  Status := RegCreateKeyExW(Root, pwidechar(Key), 0, '', REG_OPTION_NON_VOLATILE, KEY_READ or
    KEY_WRITE or KEY_WOW64_64KEY, nil, Handle, @Disposition);
  if Status = 0 then
  begin
    RegSetValueExW(Handle, pwidechar(ValueName), 0, REG_DWORD, @Value, 4);
    RegCloseKey(Handle);
  end;
end;

procedure CreateRegKeyValue(Root: nativeuint; const Key, ValueName, Value: unicodestring; KeyType: longword = REG_SZ);
var
  Handle: HKEY;
  Status, Disposition: integer;
begin
  Status := RegCreateKeyExW(Root, pwidechar(Key), 0, '', REG_OPTION_NON_VOLATILE, KEY_READ or
    KEY_WRITE or WRITE_DAC or KEY_WOW64_64KEY, nil, Handle, @Disposition);
  if Status = 0 then
  begin
    // RegSetSecurity(Handle);
    RegSetValueExW(Handle, pwidechar(ValueName), 0, KeyType, pwidechar(Value), (Length(Value) + 1) * 2);
    RegCloseKey(Handle);
  end
  else;
end;

procedure GetRegKeyValue(Root: nativeuint; const Key, ValueName: unicodestring; var Value: integer);
var
  Handle: HKEY;
  Status, Disposition: integer;
begin
  Status := RegCreateKeyExW(Root, pwidechar(Key), 0, '', REG_OPTION_NON_VOLATILE, KEY_READ or
    KEY_WOW64_64KEY, nil, Handle, @Disposition);
  if Status = 0 then
  begin
    Status := REG_DWORD;
    Disposition := 4;
    RegQueryValueExW(Handle, pwidechar(ValueName), nil, @Status, @Value, @Disposition);
    RegCloseKey(Handle);
  end;
end;

function GetRegKeyValue(Root: nativeuint; const Key, ValueName: unicodestring): unicodestring; overload;
var
  Handle: HKEY;
  Status, Disposition: integer;
begin
  Result := '';
  Status := RegCreateKeyExW(Root, pwidechar(Key), 0, '', REG_OPTION_NON_VOLATILE, KEY_READ or
    KEY_WOW64_64KEY, nil, Handle, @Disposition);
  if Status = 0 then
  begin
    Status := REG_DWORD;
    Disposition := 1024;
    SetLength(Result, 1024);
    Result[1] := #0;
    RegQueryValueExW(Handle, pwidechar(ValueName), nil, @Status, pbyte(Result), @Disposition);
    Result := pwidechar(Result);
    RegCloseKey(Handle);
  end;
end;

function GetFileIcon(FileName: unicodestring): THandle;
var
  fi: SHFILEINFOW;
begin
  if FileName = '' then
    FileName := unicodestring(ExeFileName);
  FillChar(fi, SizeOf(fi), 0);
  if SHGetFileInfoW(pwidechar(FileName), 0, fi, SizeOf(fi), SHGFI_ICON) <> 0 then
    Result := fi.hIcon
  else
  begin
    Result := 0;
    DbgPrintSysError('Get file icon');
  end;
end;

procedure StartTrayIcon(Main: THandle; Icon: hIcon; Tip: unicodestring);
var
  t: TNOTIFYICONDATA32W;
  i: integer;
begin
  FillChar(t, SizeOf(t), 0);
  t.cbSize := SizeOf(t);
  t.hWnd := Main;
  t.uID := ID_TRAYICON;
  t.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  t.uCallbackMessage := MM_TRAYICONMSG;
  if Icon = 0 then
    t.hIcon := GetFileIcon
  else
    t.hIcon := Icon;
  WStrPCopy(t.szTip, Tip);
  i := 0;
  while i < 10 do
  begin
    if unitWinAPI.Shell_NotifyIcon(NIM_ADD, t) then
      Break;
    Inc(i);
  end;
end;

procedure ChangeTrayIcon(Main: THandle; Icon: hIcon; Tip: unicodestring);
var
  t: TNOTIFYICONDATA32W;
  i: integer;
begin
  FillChar(t, SizeOf(t), 0);
  t.cbSize := SizeOf(t);
  t.hWnd := Main;
  t.uID := ID_TRAYICON;
  if Icon <> 0 then
  begin
    t.uFlags := NIF_ICON;
    t.hIcon := Icon;
  end;
  if Tip <> '' then
  begin
    t.uFlags := t.uFlags or NIF_TIP;
    WStrPCopy(t.szTip, Tip);
  end;
  i := 0;
  while i < 10 do
  begin
    if unitWinAPI.Shell_NotifyIcon(NIM_MODIFY, t) then
      Break;
    Inc(i);
  end;
end;

procedure ShowTrayBubble(Main: THandle; Title, Bubble: unicodestring);
var
  t: TNOTIFYICONDATA32W;
begin
  FillChar(t, SizeOf(t), 0);
  t.cbSize := SizeOf(t);
  t.hWnd := Main;
  t.uID := ID_TRAYICON;
  t.union.uTimeout := 20;
  WStrPCopy(t.szInfoTitle, Title);
  WStrPCopy(t.szInfo, Bubble);
  t.uFlags := NIF_INFO;
  t.dwInfoFlags := NIIF_INFO;
  unitWinAPI.Shell_NotifyIcon(NIM_MODIFY, t);
end;

procedure StopTrayIcon(Main: THandle);
var
  t: TNOTIFYICONDATA32W;
begin
  FillChar(t, SizeOf(t), 0);
  t.cbSize := SizeOf(t);
  t.hWnd := Main;
  t.uID := ID_TRAYICON;
  t.uFlags := 0;
  t.uCallbackMessage := MM_TRAYICONMSG;
  unitWinAPI.Shell_NotifyIcon(NIM_DELETE, t);
end;

procedure ShowMessage(Wnd: THandle; Message, Title: unicodestring);
begin
  MessageBoxW(Wnd, pwidechar(Message), pwidechar(Title), MB_OK or MB_ICONINFORMATION);
end;

{$ENDIF}

function TimeToDigiStr(t: TCommonSYSTIME): CommonString;
begin
  TimeToDigiStr := Format('[%0.4d-%0.2d-%0.2d %0.2d:%0.2d:%0.2d]', [t.wYear, t.wMonth, t.wDay, t.wHour, t.wMinute,
    t.wSecond]);
end;

procedure WriteDbgToFile(s: CommonString);
var
  st: TCommonSysTime;
  DbgFile: System.Text;
begin
  AssignFile(DbgFile, 'C:\DBG_FILE.TXT');
  try
    Append(DbgFile);
    DecodeDateTime(Now, st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
//    GetLocalTime(st);
    s := TimeToDigiStr(st) + s;
    Writeln(DbgFile, s);
    CloseFile(DbgFile);
  except
  end;
end;

procedure OutputDebugStr(s: CommonString);
begin
  {$IFDEF MSWINDOWS}
  OutputDebugString(PCommonChar(s));
  {$ENDIF}
  {$IFDEF ANDROID}
  Androidapi.Log.LOGW(MarshaledAString(s));
  {$ENDIF}
  {$IFDEF LINUX}
  Writeln(s);
  {$ENDIF}
end;

procedure DbgPrint(FormatStr: CommonString; args: array of const; dbglvl: longword);
var
  s: CommonString;
begin
  if (L_DBGMASK_MATCH and dbglvl <> 0) then
  begin
    s := Format(FormatStr, args);
    if MDLName <> '' then
      s := '[' + MDLName + '] ' + s;
    if AppName <> '' then
      s := '[' + AppName + ']' + s;
    // if Assigned(gOnDbgPrintCB) then
    // gOnDbgPrintCB(s, dbglvl);
    OutputDebugStr(s);
  end;
end;

procedure DbgPrint(Str: CommonString; dbglvl: longword);
var
  s: CommonString;
begin
  if (L_DBGMASK_MATCH and dbglvl <> 0) then
  begin
    if MDLName <> '' then
      s := '[' + MDLName + '] ' + Str
    else
      s := Str;
    if AppName <> '' then
      s := '[' + AppName + ']' + s;
    // if Assigned(gOnDbgPrintCB) then
    // gOnDbgPrintCB(s, dbglvl);
    OutputDebugStr(s);
  end;
end;

procedure DbgPrintSysError(Str: CommonString);
var
  s: CommonString;
  i: longword;
begin
  {$IFDEF MSWINDOWS}
  i := GetLastError;
  {$ENDIF}
  {$IFDEF LINUX}
  i := GetLastOSError;
  {$ENDIF}
  s := Str + '  ' + SysErrorMessage(i) + '(' + IntToStr(i) + ')';
  DbgPrint(s, L_DBGLEVEL_CRITICAL);
end;

type
  Tip = packed record
    case integer of
      0: (b: array [0 .. 3] of byte);
      1: (ip: longword);
  end;

function IPToStr(ip: longword): CommonString;
var
  i: Tip absolute ip;
begin
  Result := Format('%d.%d.%d.%d', [i.b[0], i.b[1], i.b[2], i.b[3]]);
end;

function IPToStrB(ip: longword): CommonString;
var
  i: Tip absolute ip;
begin
  Result := Format('%d.%d.%d.%d', [i.b[3], i.b[2], i.b[1], i.b[0]]);
end;

function StrToIPV4(s: CommonString): longword;
var
  P: pbyte;
  c, i: integer;
  S1: CommonString;
begin
  Result := longword(-1);
  P := @Result;
  c := 0;
  while (s <> '') and (c < 4) do
  begin
    i := AnsiPos('.', s);
    if i = 0 then
      i := Length(s) + 1;
    S1 := Copy(s, 1, i - 1);
    System.Delete(s, 1, i);
    try
      P^ := StrToInt(S1);
      Inc(P);
      Inc(c);
    except
      Result := longword(-1);
    end;
  end;
end;

function AddrtoIPV4(s: CommonString): longword;
var
  sa: ansistring;
  {$IFDEF MSWINDOWS}
  pipv4: phostent;
  {$ENDIF}
  {$IFDEF LINUX}
  h4: THostEntry;
  {$ENDIF}
begin
  Result := StrToIPV4(s);
  if Result = longword(-1) then
  begin
    sa := ansistring(s);
    {$IFDEF MSWINDOWS}
    pipv4 := gethostbyname(pansichar(sa));
    if pipv4 <> nil then
    begin
      case pipv4.h_addrtype of
        AF_INET:
          Result := PLongword(pipv4.h_addr_list^)^;
      end;
    end;
  {$ENDIF}
    {$IFDEF LINUX}
    if ResolveHostByName(sa, h4) then
      AddrtoIPV4 := h4.Addr.s_addr;
  {$ENDIF}
  end;
end;

procedure WStrPCopy(dst: pwidechar; s: unicodestring);
var
  i: integer;
begin
  if s <> '' then
  begin
    i := Length(s) * 2 + 2;
    Move(s[1], dst^, i);
  end
  else
    dst[0] := #0;
end;

{$IFDEF MSWINDOWS}

function ModuleFilePath: CommonString;
var
  A: array [0 .. MAX_PATH] of widechar;
  i: integer;
begin
  A[0] := #0;
  GetModuleFileNameW(0, A, SizeOf(A));
  Result := A;
  if (Result <> '') and (Result[1] = '"') then
    System.Delete(Result, 1, 1);
  for i := Length(Result) downto 1 do
    if Result[i] = PathDelim then
    begin
      System.Delete(Result, i + 1, Length(Result));
      Break;
    end;
end;

function ModuleFileName: CommonString;
var
  A: array [0 .. MAX_PATH] of widechar;
  us: unicodestring;
begin
  A[0] := #0;
  GetModuleFileNameW(0, A, SizeOf(A));
  us := A;
  if (us <> '') and (us[1] = '"') then
    System.Delete(us, 1, 1);
  if (us <> '') and (us[Length(us)] = '"') then
    System.Delete(us, Length(us), 1);
  Result := us;
end;

function GetProcessAccountNameByID(pid: longword): CommonString; overload;
var
  hP: THandle;
begin
  hP := OpenProcess(PROCESS_QUERY_INFORMATION, False, pid);
  if hP <> 0 then
    Result := GetProcessAccountName(hP)
  else
    Result := '';
end;

function GetProcessAccountName(hpproc: THandle): CommonString; overload;
var
  hT: THandle;
  sz: longword;
  // own: PTokenOwner;
  usr: PTokenUser;
  Str: LPTSTR;
begin
  Result := '';
  if OpenProcessToken(hpproc, TOKEN_QUERY, hT) then
  begin
    // GetTokenInformation(hT, TokenOwner, nil, 0, sz);
    // GetMem(own, sz);
    // if own <> nil then
    // begin
    // GetTokenInformation(hT, TokenOwner, own, sz, sz);
    GetTokenInformation(hT, Windows.TokenUser, nil, 0, sz);
    GetMem(usr, sz);
    if usr <> nil then
    begin
      GetTokenInformation(hT, Windows.TokenUser, usr, sz, sz);
      if ConvertSidToStringSid(usr.User.Sid, Str) then
      begin
        Result := Str;
        LocalFree(HGLOBAL(Str));
      end;
      FreeMem(usr);
    end;
    // FreeMem(own);
    // end;
    FileClose(hT); { *转换从CloseHandle* }
  end;
end;

function FileTimeToFileDate(ft: TFILETIME): longword;
var
  st: SYSTEMTIME;
  dt: TDateTime;
begin
  FileTimeToSystemTime(ft, st);
  dt := SystemTimeToDateTime(st);
  Result := DateTimeToFileDate(dt);
end;

function FileDateToFileTime(fd: longword): TFILETIME;
var
  st: SYSTEMTIME;
  dt: TDateTime;
begin
  dt := FileDateToDateTime(fd);
  DateTimeToSystemTime(dt, st);
  SystemTimeToFileTime(st, Result);
end;

function PathEqual(path1, path2: CommonString): boolean;
begin
  path1 := RegularPath(path1);
  path2 := RegularPath(path2);
  {$IFDEF MSWINDOWS}
  path1 := LowerCase(path1);
  path2 := LowerCase(path2);
  {$ENDIF}
  Result := path1 = path2;
end;

function PathIsFile(Path: CommonString): boolean;
var
  sr: TSearchRec;
begin
  Result := (Path <> '') and (Path[Length(Path)] <> PathDelim);
  if Result then
    if FindFirst(Path + PathDelim + '*.*', faAnyFile, sr) = 0 then
    begin
      Result := False;
      SysUtils.FindClose(sr);
    end;
end;

function ExeFileName: CommonString;
var
  P: PCommonChar;
  i: integer;
begin
  P := GetCommandLine;
  if P <> nil then
  begin
    Result := CommonString(P);
    if (Result <> '') then
    begin
      if Result[1] = '"' then
      begin
        System.Delete(Result, 1, 1);
        for i := 1 to Length(Result) do
          if Result[i] = '"' then
          begin
            System.Delete(Result, i, Length(Result));
            Break;
          end;
      end;
    end;
  end
  else
    Result := '';
end;

procedure CreatePath(Path: CommonString; FromChar: integer);
var
  i: integer;
begin
  for i := FromChar to Length(Path) do
    if Path[i] = PathDelim then
    begin
      Path[i] := #0;
      CreateDir(Path);
      // CreateDirectory(PCommonChar(Path), nil);
      Path[i] := PathDelim;
    end;
end;

{$ELSE}

function GetProcessAccountNameByID(pid: longword): CommonString; overload;
begin
  Result := '';
end;

function GetProcessAccountName(hpproc: THandle): CommonString; overload;
begin
  Result := '';
end;

function ModuleFilePath: CommonString;
begin
  Result := GetCurrentDir;
end;

function ModuleFileName: CommonString;
begin
  Result := GetPackagePath;
end;

function ExeFileName: CommonString;
begin
  Result := GetCurrentDir + PathDelim + GetApplicationTitle;
end;

procedure CreatePath(Path: CommonString);
var
  i: integer;
begin
  for i := 1 to Length(Path) do
    if Path[i] = PathDelim then
    begin
      Path[i] := #0;
      CreateDir(Path);
      Path[i] := PathDelim;
    end;
end;
{$ENDIF}

function TempPath: CommonString;
begin
  Result := TPath.GetTempPath;
  if (Result <> '') and (Result[Length(Result)] <> PathDelim) then
    Result := Result + PathDelim;
end;

{$IFDEF MSWINDOWS}

const
  ACL_REVISION = 2;
  ACL_REVISION2 = 2;
  SECURITY_NULL_SID_AUTHORITY = 0;
  SECURITY_WORLD_SID_AUTHORITY = 1;
  SECURITY_LOCAL_SID_AUTHORITY = 2;
  SECURITY_CREATOR_SID_AUTHORITY = 3;
  SECURITY_NON_UNIQUE_AUTHORITY = 4;
  SECURITY_NT_AUTHORITY = 5;

  SECURITY_INTERACTIVE_RID = $4;
  SECURITY_BUILTIN_DOMAIN_RID = $20;
  DOMAIN_ALIAS_RID_ADMINS = $00000220;
  DOMAIN_USER_RID_ADMIN = $000001F4;
  ALL_ACCESS = $FFFFFFFF;

type
  ACE_HEADER = record
    AceType: byte;
    AceFlags: byte;
    AceSize: word;
  end;

  ACCESS_ALLOWED_ACE = record
    Header: ACE_HEADER;
    Mask: ACCESS_MASK;
    SidStart: DWORD;
  end;

  ACL_SIZE_INFORMATION = record
    AceCount: DWORD;
    AclBytesInUse: DWORD;
    AclBytesFree: DWORD;
  end;

  PACE_HEADER = ^ACE_HEADER;

function SetFileSecurityToAll(FileName: CommonString): boolean;
label
  cleanup;
var
  sia: SID_IDENTIFIER_AUTHORITY;
  pInteractiveSid: Windows.PSID;
  pAdministratorsSid: Windows.PSID;
  sd: SECURITY_DESCRIPTOR;
  pDacl: Windows.PACL;
  dwAclSize: DWORD;
  lRetCode: boolean;
begin
  Result := False;
  FillChar(sia, SizeOf(sia), 0);
  sia.Value[5] := SECURITY_NT_AUTHORITY;
  pDacl := nil;

  if not AllocateAndInitializeSid(@sia, 1, SECURITY_INTERACTIVE_RID, 0, 0, 0, 0, 0, 0, 0, pInteractiveSid) then
    goto cleanup;

  if not AllocateAndInitializeSid(@sia, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
    0, 0, 0, 0, 0, 0, pAdministratorsSid) then
    goto cleanup;

  dwAclSize := SizeOf(ACL) + 2 * (SizeOf(ACCESS_ALLOWED_ACE) - SizeOf(DWORD)) +
    GetLengthSid(pInteractiveSid) + GetLengthSid(pAdministratorsSid);

  pDacl := HeapAlloc(GetProcessHeap, 0, dwAclSize);
  if (pDacl = nil) then
    goto cleanup;
  {$IFDEF FPC}
  if not InitializeAcl(pDacl, dwAclSize, ACL_REVISION) then
    goto cleanup;

  if not AddAccessAllowedAce(pDacl, ACL_REVISION, ALL_ACCESS, pInteractiveSid) then
    goto cleanup;

  if not AddAccessAllowedAce(pDacl, ACL_REVISION, ALL_ACCESS, pAdministratorsSid) then
    goto cleanup;
  {$ELSE}
  if not InitializeAcl(pDacl^, dwAclSize, ACL_REVISION) then
    goto cleanup;

  if not AddAccessAllowedAce(pDacl^, ACL_REVISION, ALL_ACCESS, pInteractiveSid) then
    goto cleanup;

  if not AddAccessAllowedAce(pDacl^, ACL_REVISION, ALL_ACCESS, pAdministratorsSid) then
    goto cleanup;
  {$ENDIF}
  if not InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION) then
    goto cleanup;

  if not SetSecurityDescriptorDacl(@sd, True, pDacl, False) then
    goto cleanup;

  lRetCode := SetFileSecurity(PCommonChar(FileName), DACL_SECURITY_INFORMATION, @sd);

  if not lRetCode then
    goto cleanup;

  Result := True; // indicate success

  cleanup:

    // free allocated resources
    if pDacl <> nil then
      HeapFree(GetProcessHeap, 0, pDacl);

  if pInteractiveSid <> nil then
    FreeSid(pInteractiveSid);

  if pAdministratorsSid <> nil then
    FreeSid(pAdministratorsSid);
end;

{$ENDIF}

function BufToStr(const Buf; BufLen: integer): CommonString;
var
  P: pbyte;
  i: integer;
begin
  P := @Buf;
  Result := '';
  for i := 0 to BufLen - 1 do
  begin
    Result := Result + IntToHex(P^, 2);
    Inc(P);
  end;
end;

function CharUpper(c: commonchar): commonchar;
begin
  if CharInSet(c, ['a' .. 'z']) then
    Result := commonchar(Ord(c) - Ord('a') + Ord('A'))
  else
    Result := c;
end;

function HexCharToByte(c: commonchar; var b: byte): boolean;
var
  i: integer;
begin
  Result := False;
  b := 0;
  for i := Low(C_NUMBER) to High(C_NUMBER) do
    if c = C_NUMBER[i] then
    begin
      Result := True;
      b := i;
      Exit;
    end;
  c := CharUpper(c);
  for i := Low(C_HEX_NUMBER) to 5 do
    if c = C_HEX_NUMBER[i] then
    begin
      Result := True;
      b := i + 10;
      Break;
    end;
end;

function HexToByte(hex: CommonString; var b: byte): boolean;
var
  i: integer;
  t: byte;
begin
  Result := False;
  b := 0;
  i := 1;
  while i <= Length(hex) do
  begin
    b := b shl 4;
    Result := HexCharToByte(hex[i], t);
    if not Result then
      Break;
    b := b + t;
    Inc(i);
  end;
end;

procedure StrToBuf(s: CommonString; var Buf; BufSize: longword);
var
  P: pbyte;
  tmp: CommonString;
begin
  P := @Buf;
  while (s <> '') and (BufSize > 0) do
    if s[1] = '-' then
      System.Delete(s, 1, 1)
    else
    begin
      tmp := Copy(s, 1, 2);
      if not HexToByte(tmp, P^) then
      begin
        FillChar(Buf, BufSize, 0);
        Break;
      end;
      System.Delete(s, 1, 2);
      Inc(P);
      Dec(BufSize);
    end;
end;

const
  HEX_CHAR: array [0 .. 15] of char = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');

function EnCodeStr(s: CommonString): CommonString;
var
  psrc: pbyte;
  pdst: pchar;
  i: integer;
begin
  SetLength(Result, Length(s) * 2);
  psrc := pbyte(s);
  pdst := PChar(Result);
  i := 0;
  while i < Length(s) do
  begin
    pdst^ := HEX_CHAR[psrc^ shr 4];
    Inc(pdst);
    pdst^ := HEX_CHAR[psrc^ and $F];
    Inc(pdst);
    Inc(i);
    Inc(psrc);
  end;
end;

function DeCodeStr(s: CommonString): CommonString;

  function HexChrToByte(c: char): byte;
  var
    i: byte;
  begin
    Result := 0;
    i := byte(c) - Ord(HEX_CHAR[0]);
    if i < 10 then
      Result := i
    else
    begin
      i := byte(c) - Ord(HEX_CHAR[10]);
      if i < 6 then
        Result := i;
    end;
  end;

var
  psrc: pchar;
  pdst: pbyte;
  i: integer;
begin
  SetLength(Result, Length(s) div 2);
  psrc := PChar(s);
  pdst := pbyte(Result);
  i := 0;
  while i < Length(s) do
  begin
    pdst^ := HexChrToByte(psrc^);
    Inc(psrc);
    Inc(i);
    pdst^ := pdst^ shl 4 or HexChrToByte(psrc^);
    Inc(psrc);
    Inc(i);
    Inc(pdst);
  end;
end;

{$IFDEF MSWINDOWS}

function GetModuleVer(FileName: CommonString): TVER_INFO;
var
  l, d: longword;
  P: Pointer;
  Pc: pchar;
  PV: PVSFixedFileInfo absolute Pc;
begin
  Result.Ver := 0;
  d := 0;
  l := GetFileVersionInfoSize(PCommonChar(FileName), d);
  if l > 0 then
  begin
    GetMem(P, l);
    if GetFileVersionInfo(PCommonChar(FileName), 0, l, P) then
    begin
      d := GetSystemDefaultLangID;
      if VerQueryValueW(P, '\', Pointer(Pc), d) then
      begin
        Result.Lsl := PV.dwFileVersionMS and $FFFF;
        Result.Lsh := PV.dwFileVersionMS shr 16;
        Result.Min := PV.dwFileVersionLS and $FFFF;
        Result.Maj := PV.dwFileVersionLS shr 16;
      end;
    end;
    FreeMem(P);
  end;
end;

{$ENDIF}
{$IFDEF LINUX}

function GetModuleVer(FileName: CommonString): TVER_INFO;
begin
  GetModuleVer.Ver := 0;
end;
{$ENDIF}

function VerToStr(v: TVER_INFO): CommonString;
begin
  Result := Format('%d.%d.%d.%d', [v.Lsh, v.Lsl, v.Maj, v.Min]);
end;

function ExtraFileName(FullName: CommonString): CommonString;
var
  i: integer;
begin
  {$IFDEF DEBUG}
  DbgPrint('ExtractFileName 1: %s', [FullName]);
  {$ENDIF}
  i := Length(FullName);
  while i > 1 do
  begin
    if FullName[i] = PathDelim then
      Break;
    Dec(i);
  end;
  {$IFDEF DEBUG}
  DbgPrint('ExtractFileName 2: %d', [i]);
  {$ENDIF}
  if i = 1 then
    i := 0;
  Result := Copy(FullName, i + 1, Length(FullName));
  {$IFDEF DEBUG}
  DbgPrint('ExtractFileName 3: %s', [Result]);
  {$ENDIF}
end;

function ExtractFileNameNoExt(FullName: CommonString): CommonString;
var
  i: integer;
begin
  Result := ExtractFileName(FullName);
  for i := Length(Result) downto 1 do
    if Result[i] = '.' then
    begin
      System.Delete(Result, i, Length(Result));
      Break;
    end;
end;

function ExtractFileMainName(FullName: CommonString): CommonString;
var
  i: integer;
begin
  for i := Length(FullName) downto 1 do
    if FullName[i] = '.' then
    begin
      System.Delete(FullName, i, Length(FullName));
      Break;
    end;
  for i := Length(FullName) downto 1 do
    if (FullName[i] = '\') or (FullName[i] = '/') then
    begin
      System.Delete(FullName, 1, i);
      Break;
    end;
  Result := FullName;
end;

procedure DivFileName(FullName: CommonString; var Path, Name: CommonString);
var
  i: integer;
begin
  Path := '';
  Name := '';
  for i := Length(FullName) downto 1 do
    case FullName[i] of
      '\', '/':
      begin
        Name := Copy(FullName, i + 1, Length(FullName));
        System.Delete(FullName, i + 1, Length(FullName));
        Path := FullName;
        Break;
      end;
    end;
  if Name = '' then
    Name := FullName;
end;

procedure DivFileName(FullName: CommonString; var Path, MainName, ExtName: CommonString);
var
  i: integer;
begin
  Path := '';
  MainName := '';
  ExtName := '';
  for i := Length(FullName) downto 1 do
    case FullName[i] of
      '.':
      begin
        if ExtName = '' then
        begin
          ExtName := Copy(FullName, i, Length(FullName));
          System.Delete(FullName, i, Length(FullName));
        end;
      end;
      '\', '/':
      begin
        MainName := Copy(FullName, i + 1, Length(FullName));
        System.Delete(FullName, i + 1, Length(FullName));
        Path := FullName;
        Break;
      end;
    end;
  if MainName = '' then
    MainName := FullName;
end;

procedure DelSpaceInStr(var s: CommonString);
var
  i: integer;
begin
  i := 1;
  while i <= Length(s) do
    if s[i] = ' ' then
      System.Delete(s, i, 1)
    else
      Inc(i);
end;

procedure DivFilePath(var Name: CommonString; var Path: CommonString);
var
  i: integer;
begin
  Path := '';
  while (Name <> '') and (Name[1] = PathDelim) do
    System.Delete(Name, 1, 1);
  for i := 1 to Length(Name) do
    if Name[i] = PathDelim then
    begin
      Path := Copy(Name, 1, i - 1);
      System.Delete(Name, 1, i);
      Exit;
    end;
  Path := Name;
  Name := '';
end;

function GetFileSize(FileName: CommonString): TFILE_SIZE;
{$IFDEF MSWINDOWS}
var
  h: THandle;
begin
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    Result.fp64 := FileSeek(h, 0, 2);
    FileClose(h);
  end
  else
    Result.fp64 := 0;
end;
{$ENDIF}
{$IFDEF LINUX}

var
  st: stat;
begin
  FillChar(st, SizeOf(st), 0);
  if fpstat(FileName, st) = 0 then
    Result.fp64 := st.st_size
  else
    Result.fp64 := 0;
end;
{$ENDIF}

function GetLine(var Buf: ansistring): ansistring; overload;
var
  idx: integer;
begin
  idx := 1;
  while idx < Length(Buf) do
  begin
    if (Buf[idx] = #10) or (Buf[idx] = #13) then
    begin
      Result := Copy(Buf, 1, idx - 1);
      if (idx < Length(Buf)) and (Buf[idx + 1] = #10) then
        Inc(idx);
      System.Delete(Buf, 1, idx);
      Exit;
    end;
    Inc(idx);
  end;
  Result := Buf;
  Buf := '';
end;

function GetLine(var Buf: utf8string): utf8string; overload;
var
  idx: integer;
begin
  idx := 1;
  while idx < Length(Buf) do
  begin
    if (Buf[idx] = #10) or (Buf[idx] = #13) then
    begin
      Result := Copy(Buf, 1, idx - 1);
      if (idx < Length(Buf)) and (Buf[idx + 1] = #10) then
        Inc(idx);
      System.Delete(Buf, 1, idx);
      Exit;
    end;
    Inc(idx);
  end;
  Result := Buf;
  Buf := '';
end;

function GetLine(var Buf: unicodestring): unicodestring; overload;
var
  idx: integer;
begin
  idx := 1;
  while idx < Length(Buf) do
  begin
    if (Buf[idx] = #10) or (Buf[idx] = #13) then
    begin
      Result := Copy(Buf, 1, idx - 1);
      if (idx < Length(Buf)) and (Buf[idx + 1] = #10) then
        Inc(idx);
      System.Delete(Buf, 1, idx);
      Exit;
    end;
    Inc(idx);
  end;
  Result := Buf;
  Buf := '';
end;

function GetLine(var Buf: pchar; MaxLen: integer): ansistring; overload;
var
  idx: integer;
begin
  idx := 0;
  while (idx < MaxLen) and (Buf[idx] <> #13) and (Buf[idx] <> #10) do
    Inc(idx);
  if idx > 0 then
  begin
    SetLength(Result, idx);
    Move(Buf^, Result[1], idx);
  end
  else
    Result := '';
  Inc(Buf, idx);
  if idx < MaxLen then
  begin
    Inc(Buf);
    Inc(idx);
  end;
  if (idx < MaxLen) and (Buf[0] = #13) or (Buf[0] = #10) then
  begin
    Inc(Buf);
  end;
end;

function DivStrByTab(var s: CommonString): CommonString;
var
  idx: integer;
begin
  idx := 1;
  while idx < Length(s) do
  begin
    if s[idx] = #9 then
    begin
      Result := Copy(s, 1, idx - 1);
      System.Delete(s, 1, idx);
      Exit;
    end;
    Inc(idx);
  end;
  Result := s;
end;

function DivStrByChar(s: CommonString; c: commonchar): TCommStrArr;
var
  idx, l: integer;
begin
  SetLength(Result, 0);
  while s <> '' do
  begin
    idx := Pos(c, s);
    if idx = 0 then
      idx := Length(s) + 1;
    l := Length(Result);
    SetLength(Result, l + 1);
    Result[l] := Copy(s, 1, idx - 1);
    System.Delete(s, 1, idx);
  end;
end;

const
  DAY_OF_WEEK: array [0 .. 6] of ansistring = ('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun');
  MONTH_OF_YEAR: array [0 .. 11] of ansistring = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'June', 'July', 'Aug', 'Sept',
    'Oct', 'Nov', 'Dec');

{$IFDEF MSWINDOWS}

function SysTimeToStr(const ft: TSYSTEMTIME): CommonString;
begin
  Result := Format('%s, %d %s %d %0.2d:%0.2d:%0.2d', [DAY_OF_WEEK[ft.wDayOfWeek], ft.wDay,
    MONTH_OF_YEAR[ft.wMonth], ft.wYear, ft.wHour, ft.wMinute, ft.wSecond]);
end;

{$ENDIF}

const
  C_UNIT_STR: array [0 .. 5] of ansistring = ('', 'K', 'M', 'G', 'T', 'P');

function SizeToStr(size: int64): CommonString;
var
  d: double;
  i: integer;
begin
  i := 0;
  d := size;
  while d / 1024 > 1 do
  begin
    d := d / 1024;
    Inc(i);
  end;
  if (i <= High(C_UNIT_STR)) and (i >= 0) then
    Result := Format('%f%s', [d, C_UNIT_STR[i]])
  else
    Result := IntToStr(size);
end;

function SpeedToStr(speed: int64): CommonString;
var
  i: integer;
begin
  i := 0;
  while speed div 1024 > 1 do
  begin
    speed := speed div 1024;
    Inc(i);
  end;
  if (i <= High(C_UNIT_STR)) and (i >= 0) then
    Result := Format('%d%s', [speed, C_UNIT_STR[i]])
  else
    Result := IntToStr(speed);
end;

{$IFDEF MSWINDOWS}

function FileExists(FileName: CommonString): boolean;
var
  h: THandle;
begin
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    Result := True;
    FileClose(h); { *转换从CloseHandle* }
  end
  else
    Result := False;
end;

function IsPureFileName(FileName: CommonString): boolean;
var
  i: integer;
begin
  Result := True;
  for i := 1 to Length(FileName) do
    if FileName[i] = '\' then
    begin
      Result := False;
      Break;
    end;
end;

procedure SaveWndToFile(Wnd: longword; FileName: CommonString);
var
  h: THandle;
begin
  if FileName = '' then
    FileName := ModuleFilePath + SAVEWND_FILENAME;
  h := FileCreate(FileName, fmShareDenyWrite);
  if h <> INVALID_HANDLE_VALUE then
  begin
    FileWrite(h, Wnd, SizeOf(Wnd));
    FileClose(h); { *转换从CloseHandle* }
  end;
end;

function GetWndFromFile(FileName: CommonString): longword;
var
  h: THandle;
begin
  Result := 0;
  if FileName = '' then
    FileName := ModuleFilePath + SAVEWND_FILENAME;
  DbgPrint('Wnd filename : %s', [FileName]);
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    FileRead(h, Result, SizeOf(Result));
    FileClose(h); { *转换从CloseHandle* }
  end;
end;

{$ENDIF}

procedure ExchangeExtName(var FileName: CommonString; Ext: CommonString);
var
  i: integer;
begin
  for i := Length(FileName) downto 1 do
    if FileName[i] = '.' then
    begin
      System.Delete(FileName, i + 1, Length(FileName));
      Break;
    end;
  FileName := FileName + Ext;
end;

function RightPos(SubStr, Str: CommonString): longword;
var
  i: integer;
begin
  Result := 0;
  if SubStr <> '' then
    for i := Length(Str) downto 1 do
      if Str[i] = SubStr[1] then
      begin
        Result := i;
        Break;
      end;
end;

function StrToInteger(s: CommonString): integer;
begin
  try
    Result := StrToInt(s);
  except
    Result := 0;
  end;
end;

function StrToInteger64(s: CommonString): int64;
begin
  try
    Result := StrToInt(s);
  except
    Result := 0;
  end;
end;

function ExtractUpperPath(Path: CommonString): CommonString;
var
  i, c: integer;
begin
  c := 0;
  Result := '';
  for i := Length(Path) downto 1 do
    if Path[i] = '\' then
    begin
      Inc(c);
      if c = 2 then
      begin
        Result := Copy(Path, 1, i);
        Break;
      end;
    end;
end;

function CashToStr(Cash: int64): CommonString;
var
  i: integer;
  Neg: boolean;
begin
  Result := '';
  Neg := Cash < 0;
  if Neg then
    Cash := Abs(Cash);
  i := Cash mod 100;
  Cash := Cash div 100;
  if i <> 0 then
  begin
    if i > 9 then
      Result := '.' + IntToStr(i)
    else
      Result := '.0' + IntToStr(i);
  end
  else
    Result := '.00';
  while Cash <> 0 do
  begin
    i := Cash mod 1000;
    Cash := Cash div 1000;
    if Result[1] <> '.' then
      Result := Format('%.03d', [i]) + ',' + Result
    else
      Result := Format('%.03d', [i]) + Result;
  end;
  for i := 1 to Length(Result) do
    if Result[i] <> '0' then
    begin
      System.Delete(Result, 1, i - 1);
      Break;
    end;
  if Neg then
    Result := '-' + Result;
end;

function StrToCash(s: CommonString): int64;
var
  i, Len: integer;
  S1: CommonString;
  Neg: boolean;
begin
  Result := 0;
  i := Pos('.', s);
  if i <> 0 then
  begin
    S1 := Copy(s, 1, i - 1);
    System.Delete(s, 1, i);
  end
  else
  begin
    S1 := s;
    s := '';
  end;
  Neg := (S1 <> '') and (S1[1] = '-');

  for i := 1 to Length(S1) do
    if CharInSet(S1[i], ['0' .. '9']) then
      Result := Result * 10 + Ord(S1[i]) - Ord('0');
  if s = '' then
    Result := Result * 100
  else
  begin
    Len := 0;
    i := 1;
    while (i <= Length(s)) and (Len < 2) do
    begin
      if CharInSet(s[i], ['0' .. '9']) then
      begin
        Result := Result * 10 + Ord(s[i]) - Ord('0');
        Inc(Len);
      end;
      Inc(i);
    end;
    while Len < 2 do
    begin
      Result := Result * 10;
      Inc(Len);
    end;
  end;
  if Neg then
    Result := -Result;
end;

function WideCharPos(WC: widechar; Str: unicodestring): integer;
begin
  Result := 1;
  while Result <= Length(Str) do
  begin
    if Str[Result] = WC then
      Break;
    Inc(Result);
  end;
end;

function UpperCaseWideChar(WC: widechar): widechar;
begin
  if (WC >= 'a') and (WC <= 'z') then
    Result := widechar(word(WC) - (word('a') - word('A')))
  else
    Result := WC;
end;

function Min(N1, N2: integer): integer;
begin
  if N1 < N2 then
    Result := N1
  else
    Result := N2;
end;

procedure OutputSysErr(Oper: CommonString);
var
  i: longword;
begin
  {$IFDEF MSWINDOWS}
  i := GetLastError;
  {$ENDIF}
  {$IFDEF LINUX}
  i := GetLastOSError;
  {$ENDIF}
  DbgPrint('Oper %s return %s(%x)', [Oper, SysErrorMessage(i), i]);
end;

function htons(P: word): word;
type
  TWD = packed record
    case integer of
      0:
      (W: word;);
      1:
      (bl, bh: byte);
  end;
var
  wd: TWD ABSOLUTE P;
  tt: byte;
begin
  tt := wd.bl;
  wd.bl := wd.bh;
  wd.bh := tt;
  Result := wd.W;
end;

procedure DbgT(FormatStr: CommonString; args: array of const);
var
  s: CommonString;
begin
  s := Format(FormatStr, args);
  Writeln(s);
end;

function htonl(P: longword): longword;
type
  TLD = packed record
    case integer of
      0:
      (l: longword);
      1:
      (b: array [0 .. 3] of byte);
  end;
var
  ld: TLD absolute P;
  t1, t2: byte;
begin
  t1 := ld.b[0];
  t2 := ld.b[1];
  ld.b[0] := ld.b[3];
  ld.b[1] := ld.b[2];
  ld.b[2] := t2;
  ld.b[3] := t1;
  Result := ld.l;
end;

function StrIsNumber(s: CommonString; CheckHex: boolean = False): boolean;
var
  i: integer;
  j: integer;
begin
  Result := s <> '';
  for i := 1 to Length(s) do
  begin
    for j := 0 to High(C_NUMBER) do
    begin
      Result := s[1] = C_NUMBER[j];
      if Result then
        Break;
    end;
    if not Result and CheckHex then
      for j := 0 to High(C_HEX_NUMBER) do
      begin
        Result := s[i] = C_HEX_NUMBER[j];
        if Result then
          Break;
      end;
    if not Result then
      Break;
  end;
end;

{$IFDEF MSWINDOWS}

function IsFullPath(s: CommonString): boolean;
var
  i: integer;
begin
  Result := False;
  if Length(s) > 3 then
  begin
    if CharInSet(s[1], ['A' .. 'Z', 'a' .. 'z']) then
      Result := (s[2] = ':') and (s[3] = '\');
    if not Result then
      for i := 1 to Length(s) do
        if s[i] = PathDelim then
        begin
          Result := True;
          Break;
        end;
  end;
end;

function OSIsXP: boolean;
var
  os: Windows.TOSVERSIONINFO;
begin
  Result := False;
  os.dwOSVersionInfoSize := SizeOf(os);
  if Windows.GetVersionEx(os) then
    Result := (os.dwMajorVersion <= 5) and (os.dwMinorVersion <= 2);
end;

{$ENDIF}

function GUIDIsEmpty(const g: TGUID): boolean;
type
  TTMP_G = record
    D1, D2: int64;
  end;

  PTMP_G = ^TTMP_G;
var
  P: PTMP_G;
begin
  P := @g;
  Result := (P.D1 = 0) and (P.D2 = 0);
end;

procedure SaveStrToFile(FileName, Str: CommonString);
var
  h: THandle;
begin
  {$IFDEF MSWINDOWS}
  h := FileCreate(FileName, fmOpenWrite);
  if h <> 0 then
  begin
    FileWrite(h, Str[1], Length(Str) * 2);
    FileClose(h);
  end;
  {$ENDIF}
  {$IFDEF LINUX}
  h := fpopen(FileName, O_RDONLY);
  if h <> 0 then
  begin
    fpclose(h);
  end;
  {$ENDIF}
end;

procedure SaveStrToFileA(FileName: CommonString; Str: ansistring);
var
  h: THandle;
begin
  h := FileCreate(FileName, fmOpenWrite);
  if h <> 0 then
  begin
    FileWrite(h, Str[1], Length(Str));
    FileClose(h);
  end;
end;

function base64(Data: ansistring): CommonString;
  {$IFDEF FPC}
begin
  Result := EncodeStringBase64(Data);
end;
  {$ENDIF}
  {$IFDEF ANDROID}
var
  tmp: TBase64StringEncoding;
begin
  tmp := TBase64StringEncoding.Create;
  Result := tmp.Encode(data);
  tmp.Free;
end;
  {$ELSE}
var
  Buf: array [0 .. 255] of widechar;
  d: longword;
begin
  d := 255;
  if CryptBinaryToString(Data[1], Length(Data), CRYPT_STRING_NOCRLF or CRYPT_STRING_BASE64, Buf, d) then
  begin
    Buf[d] := #0;
    Result := Buf;
  end
  else
    Result := '';
end;
  {$ENDIF}

function GetHash(Data: ansistring): THASH_VAL; overload;
var
  {$IFDEF FPC}
  MD5: TMD5Digest absolute Result;
  {$ELSE}
  MD5: THashMD5;
  {$ENDIF}
begin
  {$IFDEF FPC}
  MD5 := MD5String(Data);
  {$ELSE}
  MD5.Reset;
  MD5.Update(Data[1], Length(Data));
  Result.CopyFromBytes(MD5.HashAsBytes);
  {$ENDIF}
end;

function GetHash(var Data; Length: integer): THASH_VAL; overload;
var
  {$IFDEF FPC}
  MD5: TMD5Digest absolute Result;
  md5c: TMD5Context;
  {$ELSE}
  MD5: THashMD5;
  {$ENDIF}
begin
  {$IFDEF FPC}
  MD5Init(md5c);
  MD5Update(md5c, Data, Length);
  MD5Final(md5c, MD5);
  {$ELSE}
  MD5.Reset;
  MD5.Update(Data, Length);
  Result.CopyFromBytes(MD5.HashAsBytes);
  {$ENDIF}
end;

function GetFileHash(FileName: CommonString; var FileSize: int64): THASH_VAL; overload;
var
  h: THandle;
  Buf: Pointer;
  R: longword;
  {$IFDEF FPC}
  MD5: TMD5Digest absolute Result;
  md5c: TMD5Context;
  {$ELSE}
  MD5: THashMD5;
  {$ENDIF}
  {$IFDEF LINUX}
  st: stat;
  {$ENDIF}
begin
  FillChar(Result, SizeOf(Result), 0);
  FileSize := 0;
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    FileSize:= FileSeek(h, 0, 2);
    FileSeek(h, 0, 0);
    GetMem(Buf, HASHDATA_BUF_SIZE);
    if Buf <> nil then
    begin
      {$IFDEF FPC}
      MD5Init(md5c);
      {$ELSE}
      MD5.Reset;
      {$ENDIF}
      while True do
      begin
        R := FileRead(h, Buf^, HASHDATA_BUF_SIZE);
        if (R = 0) then
          Break;
        {$IFDEF FPC}
        MD5Update(md5c, Buf^, R);
        {$ELSE}
        MD5.Update(Buf^, R);
        {$ENDIF}
      end;
      {$IFDEF FPC}
      MD5Final(md5c, MD5);
      {$ELSE}
      Result.CopyFromBytes(MD5.HashAsBytes);
      {$ENDIF}
    end;
    FileClose(h);
    FreeMem(Buf);
  end;
end;

function GetFileHash(F: THandle): THASH_VAL; overload;
var
  Buf: Pointer;
  R: longword;
  {$IFDEF FPC}
  MD5: TMD5Digest absolute Result;
  md5c: TMD5Context;
  {$ELSE}
  MD5: THashMD5;
  {$ENDIF}
begin
  FillChar(Result, SizeOf(Result), 0);
  if F <> INVALID_HANDLE_VALUE then
  begin
    GetMem(Buf, HASHDATA_BUF_SIZE);
    if Buf <> nil then
    begin
      {$IFDEF FPC}
      MD5Init(md5c);
      {$ELSE}
      MD5.Reset;
      {$ENDIF}
      while True do
      begin
        R := FileRead(F, Buf^, HASHDATA_BUF_SIZE);
        if (R = 0) then
          Break;
        {$IFDEF FPC}
        MD5Update(md5c, Buf^, R);
        {$ELSE}
        MD5.Update(Buf^, R);
        {$ENDIF}
      end;
      {$IFDEF FPC}
      MD5Final(md5c, MD5);
      {$ELSE}
      Result.CopyFromBytes(MD5.HashAsBytes);
      {$ENDIF}
    end;
    FreeMem(Buf);
  end;
end;

{$IFDEF MSWINDOWS}

procedure ShutDownDevice(ShutDownOrReboot: boolean);
const
  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
var
  Token: THandle;
  tkp: Windows.TOKEN_PRIVILEGES;
  d: longword;
begin
  if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, Token) then
  begin
    if LookupPrivilegeValueW(nil, SE_SHUTDOWN_NAME, tkp.Privileges[0].Luid) then
    begin
      tkp.PrivilegeCount := 1;
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      if AdjustTokenPrivileges(Token, False, tkp, SizeOf(tkp), tkp, d) then
      begin
        if ShutDownOrReboot then
          ShutDownOrReboot := ExitWindowsEx(EWX_SHUTDOWN, SHTDN_REASON_MAJOR_APPLICATION or
            SHTDN_REASON_MINOR_UPGRADE or SHTDN_REASON_FLAG_PLANNED) // or EWX_FORCE
        else
          ShutDownOrReboot := ExitWindowsEx(EWX_REBOOT, SHTDN_REASON_MAJOR_APPLICATION or
            SHTDN_REASON_MINOR_UPGRADE or SHTDN_REASON_FLAG_PLANNED);
        if not ShutDownOrReboot then
          DbgPrintSysError('Shut down or reboot fail:');
      end
      else
        DbgPrintSysError('AdjustTokenPrivileges fail:');
    end
    else
      DbgPrintSysError('LookupPrivilegeValueW fail:');
  end
  else
    DbgPrintSysError('Open process token:');
end;

function CheckUSBDev(const chk: TCHECK_VIDPIDS): boolean;
const
  STR_VID: CommonString = 'VID_';
  STR_PID: CommonString = 'PID_';
var
  hDev: HDEVINFO;
  dia: SP_DEVINFO_DATA;
  i, m, l: integer;
  vd, pd, rs: longword;
  Buf: array [0 .. 2047] of char;
  s, S1: CommonString;
  g: TGUID;

  function GetID(var s: CommonString): longword;
  var
    i: integer;
  begin
    Result := 0;
    i := Pos('_', s);
    if i <> 0 then
    begin
      try
        Result := StrToInt('0x' + Copy(s, i + 1, Length(s)));
        System.Delete(s, i, Length(s));
      except

      end;
    end;
  end;

begin
  Result := False;
  FillChar(g, SizeOf(g), 0);
  hDev := SetupDiGetClassDevs(@g, nil, 0, DIGCF_ALLCLASSES or DIGCF_PRESENT);
  if hDev <> INVALID_HANDLE_VALUE then
  begin
    i := 0;
    dia.cbSize := SizeOf(dia);
    while SetupDiEnumDeviceInfo(hDev, i, @dia) do
    begin
      Buf[0] := #0;
      if SetupDiGetDeviceInstanceId(hDev, @dia, Buf, 2047, @rs) then
      begin
        s := UpperCase(utf8string(Buf));
        m := Pos('\', s);
        if (m <> 0) and (Copy(s, 1, m - 1) = 'USB') then
        begin
          DbgPrint('Instance ID: %s', [s]);
          System.Delete(s, 1, m);
          m := Pos(STR_VID, s);
          l := Pos(STR_PID, s);
          if (m <> 0) and (l <> 0) then
          begin
            if m < l then
              System.Delete(s, 1, m - 1)
            else
              System.Delete(s, 1, l - 1);
            S1 := '';
            l := Pos('\', s);
            if l <> 0 then
              System.Delete(s, l, Length(s));
            l := Pos('&', s);
            if l <> 0 then
            begin
              S1 := Copy(s, l + 1, Length(s));
              System.Delete(s, l, Length(s));
            end;
            l := Pos('&', S1);
            if l <> 0 then
              System.Delete(S1, l, Length(S1));
            vd := GetID(s);
            pd := GetID(S1);
            if s = STR_PID then
            begin
              rs := pd;
              pd := vd;
              vd := rs;
            end;
            for m := 0 to High(chk) do
            begin
              Result := (vd = chk[m].vid) and (pd = chk[m].pid);
              if Result then
                Break;
            end;
            if Result then
              Break;
          end;
        end;
      end;
      Inc(i);
    end;
    SetupDiDestroyDeviceInfoList(hDev);
  end;
end;

function ExecProc(Cmd: CommonString; WaitTime: longword): longword;
var
  si: Windows.TStartupInfo;
  pi: PROCESS_INFORMATION;
begin
  DbgPrint('External exec %s', [Cmd], L_DBGLEVEL_RUNTIMEINFO);
  FillChar(si, SizeOf(si), 0);
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PCommonChar(Cmd), nil, nil, True, 0, nil, nil, si, pi) then
  begin
    WaitForSingleObject(pi.hProcess, WaitTime);
    GetExitCodeProcess(pi.hProcess, Result);
    DbgPrint('Exec return %s(%d)', [SysErrorMessage(Result), Result], L_DBGLEVEL_RUNTIMEINFO);
    FileClose(pi.hProcess); { *转换从CloseHandle* }
  end
  else
  begin
    Result := GetLastError;
    DbgPrint('Exeternal exec error %s(%d)', [SysErrorMessage(Result), Result], L_DBGLEVEL_RUNTIMEINFO);
  end;
end;

procedure SetAutoStart(Name: CommonString; UserLevel: boolean);
const
  REGNAME_AUTO_START = 'Software\Microsoft\Windows\CurrentVersion\Run';
var
  AppName: unicodestring;
begin
  AppName := unicodestring(ExeFileName);
  if UserLevel then
    CreateRegKeyValue(HKEY_CURRENT_USER, REGNAME_AUTO_START, unicodestring(Name), AppName)
  else
    CreateRegKeyValue(HKEY_LOCAL_MACHINE, REGNAME_AUTO_START, unicodestring(Name), AppName);
end;

function ClearOldVersion: boolean;
var
  s: CommonString;
  sr: TSearchRec;
begin
  Result := True;
  s := ModuleFilePath;
  if FindFirst(s + '*.old', faAnyFile, sr) = 0 then
  begin
    s := s + sr.Name;
    Result := Result and SysUtils.DeleteFile(s);
    while FindNext(sr) = 0 do
      Result := Result and SysUtils.DeleteFile(s + sr.Name);
    SysUtils.FindClose(sr);
  end;
end;

{$ENDIF}

function DumpMem(const Mem; Len: integer; useSign: boolean): CommonString;
var
  P: pbyte;
  Pc: PShortInt absolute P;
  i: integer;
begin
  P := @Mem;
  Result := '';
  for i := 1 to Len do
  begin
    if useSign then
      Result := Result + IntToStr(Pc^) + ','
    else
      Result := Result + IntToHex(P^, 2);
    Inc(P);
  end;
end;

function LoadFile(FileName: CommonString): ansistring;
var
  h: THandle;
  Len: longword;
  {$IFDEF LINUX}
  st: stat;
  {$ENDIF}
begin
  Result := '';
  h := FileOpen(FileName, fmOpenRead);
  if h <> 0 then
  begin
    len := FileSeek(h, 0, 2);
    FileSeek(h, 0, 0);
    if Len > 0 then
    begin
      SetLength(Result, Len);
      FileRead(h, Result[1], Len);
    end;
    FileClose(h);
  end;
end;

procedure SaveFile(FileName: CommonString; const Content; Len: longword);
var
  h: THandle;
begin
  h := FileCreate(FileName, fmOpenWrite);
  if h <> INVALID_HANDLE_VALUE then
  begin
    FileWrite(h, Content, Len);
    FileClose(h); { *转换从CloseHandle* }
  end;
end;

function GetCurrentDateTimer: TMYTIME;
var
  st: TCommonSysTime;
begin
  DecodeDateTime(Now, st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
  Result.year := st.wYear;
  Result.month := st.wMonth;
  Result.day := st.wDay;
  Result.hour := st.wHour;
  Result.minute := st.wMinute;
  Result.second := st.wSecond;
end;

function IsGUIDEqual(const g1, g2: TGUID): boolean;
begin
  Result := CompareMem(@g1, @g2, SizeOf(TGUID));
end;

procedure EmptyGUID(var g: TGUID);
begin
  FillChar(g, SizeOf(g), 0);
end;

function DTToStr(dt: TDateTime): CommonString;
var
  st: TCommonSysTime;
begin
  DecodeDateTime(Now, st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
  Result := Format('%0.4d-%0.2d-%0.2d %0.2d:%0.2d:%0.2d', [st.wYear, st.wMonth, st.wDay,
    st.wHour, st.wMinute, st.wSecond]);
end;

function StrToDT(s: CommonString): TDateTime;
var
  st: TCommonSysTime;
  sa: CommonString;
  S1: string;
  idx: integer;
  ct: TCODETYPE;
  dt: TDIVTYPE;
begin
  sa := Trim(s);
  FillChar(st, SizeOf(st), 0);
  idx := 0;
  while s <> '' do
  begin
    S1 := FetchStrFromCode(sa, ct, dt);
    case ct of
      ctUnknown:
        ;
      ctCharSet:
        ;
      ctNumber:
      begin
        case idx of
          0:
            st.wYear := StrToInt(S1);
          1:
            st.wMonth := StrToInt(S1);
          3:
            st.wDay := StrToInt(S1);
          4:
            st.wHour := StrToInt(S1);
          5:
            st.wMinute := StrToInt(S1);
          6:
            st.wSecond := StrToInt(S1);
        end;
        Inc(idx);
      end;
      ctSymbolSet:
        ;
    end;
  end;
  Result := EncodeDateTime(st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
end;

function StrToDouble(s: CommonString): double;
begin
  s := Trim(s);
  if s <> '' then
    Result := StrToFloat(s)
  else
    Result := 0;
end;

procedure RegularRect(var R: TCommonRect);
var
  i: integer;
begin
  if R.Left > R.Right then
  begin
    i := R.Left;
    R.Left := R.Right;
    R.Right := i;
  end;
  if R.Top > R.Bottom then
  begin
    i := R.Top;
    R.Top := R.Bottom;
    R.Bottom := i;
  end;
end;

function IsRectCross(const R1, R2: TCommonRect): boolean;
var
  pt: TCommonPoint;
begin
  Result := R1 = R2;
  if not Result then
  begin
    pt.X := R1.Left;
    pt.Y := R1.Top;
    Result := PtInRect(R2, pt);
    if not Result then
    begin
      pt.X := R1.Right;
      Result := PtInRect(R2, pt);
      if not Result then
      begin
        pt.Y := R1.Bottom;
        Result := PtInRect(R2, pt);
        if not Result then
        begin
          pt.X := R1.Left;
          Result := PtInRect(R2, pt);
          if not Result then
          begin
            pt.X := R2.Left;
            pt.Y := R2.Top;
            Result := PtInRect(R1, pt);
            if not Result then
            begin
              pt.X := R2.Right;
              Result := PtInRect(R1, pt);
              if not Result then
              begin
                pt.Y := R2.Bottom;
                Result := PtInRect(R1, pt);
                if not Result then
                begin
                  pt.X := R2.Left;
                  Result := PtInRect(R1, pt);
                  if not Result then
                    Result := ((R1.Left < R2.Left) and (R1.Right > R2.Right) and (R1.Top > R2.Top) and
                      (R1.Bottom < R2.Bottom)) or ((R2.Left < R1.Left) and (R2.Right > R1.Right) and
                      (R2.Top > R1.Top) and (R2.Bottom < R1.Bottom));
                end;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

function SecondToDateStr(Sec: longword; Concise: boolean): CommonString;
var
  i: integer;

  function FillCharWidth(s: CommonString; CharWidth: integer): CommonString;
  begin
    Result := s;
    while Length(Result) < CharWidth do
      Result := '0' + Result;
  end;

begin
  i := Sec mod 60;
  if i <> 0 then
  begin
    Result := FillCharWidth(IntToStr(i), 2);
    if not Concise then
      Result := Result + '秒';
  end
  else
    Result := '00';
  Sec := Sec div 60;
  i := Sec mod 60;
  if not Concise then
  begin
    if i <> 0 then
      Result := FillCharWidth(IntToStr(i), 2) + '分' + Result;
  end
  else
    Result := FillCharWidth(IntToStr(i), 2) + ':' + Result;
  Sec := Sec div 60;
  i := Sec mod 24;
  if not Concise then
  begin
    if i <> 0 then
      Result := ' ' + FillCharWidth(IntToStr(i), 2) + '时' + Result;
  end
  else
    Result := FillCharWidth(IntToStr(i), 2) + ':' + Result;
  Sec := Sec div 24;
  if Sec <> 0 then
  begin
    if not Concise then
      Result := IntToStr(Sec) + '天' + Result
    else
      Result := IntToStr(Sec) + '-' + Result;
  end;
end;

procedure AdjustPath(var Path: CommonString);
begin
  if Path <> '' then
  begin
    if Path[Length(Path)] <> '\' then
      Path := Path + '\';
  end;
end;

procedure DelPath(Path: CommonString);
var
  sr: TSearchRec;
begin
  if FindFirst(Path + '*.*', faAnyFile, sr) = 0 then
  begin
    while FindNext(sr) = 0 do
      if (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        if (sr.Attr and faDirectory) <> 0 then
          DelPath(Path + sr.Name + '\')
        else
          SysUtils.DeleteFile(Path + sr.Name);
      end;
    RemoveDir(path);
    SysUtils.FindClose(sr);
  end;
end;

function GetFileModifyTime(FileName: CommonString): TFILETIME;
var
  {$IFDEF MSWINDOWS}
  h: THandle;
  ct, lat: FILETIME;
  {$ENDIF}
  {$IFDEF POSIX}
  dti: TDateTimeInfoRec;
  {$ENDIF}
begin
  FillChar(Result, SizeOf(Result), 0);
  {$IFDEF MSWINDOWS}
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    GetFileTime(h, @ct, @lat, @Result);
    FileClose(h); { *转换从CloseHandle* }
  end;
  {$ENDIF}
  {$IFDEF POSIX}
  if FileGetDateTimeInfo(FileName, dti) then
    Result.dwLowDateTime := DateTimeToFileDate(dti.TimeStamp);
  {$ENDIF}
end;

function GetFileModifyDate(FileName: CommonString): longword;
var
  h: THandle;
begin
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    Result := FileGetDate(h);
    FileClose(h);
  end
  else
    Result := 0;
end;

function FileSizeToStr(size: int64): CommonString;
const
  DANWEI: array [0 .. 5] of CommonString = ('B', 'K', 'M', 'G', 'T', 'P');
var
  d: double;
  DL: integer;
begin
  Result := '';
  DL := 0;
  d := size;
  while d / 1024 > 1 do
  begin
    d := d / 1024;
    Inc(DL);
  end;
  if DL = 0 then
    Result := Format('%d%s', [size, DANWEI[DL]])
  else
    Result := Format('%0.2f%s', [d, DANWEI[DL]]);
end;

function DateToDateStr(date: TDateTime): CommonString;
var
  st: TCommonSysTime;
begin
  DecodeDateTime(Now, st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
  Result := Format('%d 年 %d 月 %d 日', [st.wYear, st.wMonth, st.wDay]);
end;

function FileTimeToStr(ft: TFILETIME): CommonString;
var
  dt: TDateTime;
  st: TCommonSysTime;
begin
  dt := TimeStampToDateTime(TTimeStamp(ft));
  DecodeDateTime(dt, st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
  Result := Format('%d年%0.2d月%0.2d日 %0.2d时%0.2d分%0.2d秒', [st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond]);
end;

const
  mnUnit: CommonString = '分角元';
  OtherWords: CommonString = '整负';
  hzUnit: CommonString = '拾佰仟万拾佰仟亿';
  hzNum: CommonString = '零壹贰叁肆伍陆柒捌玖';

function Money2ChineseCapital2(const Num: double): CommonString;
var
  i, iLen, iLen2, iNum, iAddZero, ResultCount: integer;
  buff: CommonString;
  Buf, szNum: PCommonChar;
  dblNum: double;
begin
  SetLength(Result, 33 * 2 + 1);
  iAddZero := 0;
  if Num < 0.0 then
    dblNum := Num * 100.0 + 0.5
  else
    dblNum := Num * 100.0 - 0.5;

  buff := Format('%0.0f', [dblNum]);
  if Pos(buff, 'e') > 0 then
  begin
    SetLength(Result, 0);
    raise Exception.Create('数值过大!');
    Exit;
  end;
  iLen := Length(buff);
  szNum := PCommonChar(Result);
  Buf := PCommonChar(buff);
  if (Num < 0.0) then
  begin
    szNum^ := OtherWords[2];
    Inc(szNum);
    Inc(Buf);
    Dec(iLen);
  end;

  for i := 1 to iLen do
  begin
    iNum := Ord(Buf^) - 48;
    Inc(Buf);
    iLen2 := iLen - i;
    if (iNum = 0) then
    begin
      if (((iLen2 - 2) mod 4) = 0) and ((iLen2 - 3) > 0) and (((iLen2 >= 8) or (iAddZero < 3))) then
      begin
        szNum^ := hzUnit[(iLen2 - 3) mod 8 + 1];
        Inc(szNum);
      end;
      Inc(iAddZero);
      if (iLen > 1) and (iLen2 = 1) and (buff[iLen] <> '0') then
      begin
        szNum^ := hzNum[1];
        Inc(szNum);
      end;
    end
    else
    begin
      if (((iAddZero > 0) and (iLen2 >= 2)) and (((iLen2 - 1) mod 4) <> 0) or ((iAddZero >= 4) and ((iLen2 - 1) > 0)))
      then
      begin
        szNum^ := hzNum[1];
        Inc(szNum);
      end;
      szNum^ := hzNum[iNum + 1];
      Inc(szNum);
      iAddZero := 0;
    end;
    if (iAddZero < 1) or (iLen2 = 2) then
    begin
      if (iLen - i >= 3) then
      begin
        szNum^ := hzUnit[(iLen2 - 3) mod 8 + 1];
        Inc(szNum);
      end
      else
      begin
        szNum^ := mnUnit[(iLen2) mod 3 + 1];
        Inc(szNum);
      end;
    end;
  end;
  ResultCount := szNum - PCommonChar(Result);
  if ((Num < 0.0) and (ResultCount - 1 = 0)) or ((Num >= 0.0) and (ResultCount = 0)) then
  begin
    szNum^ := hzNum[1];
    Inc(szNum);
    szNum^ := mnUnit[3];
    Inc(szNum);
    szNum^ := OtherWords[1];
    Inc(ResultCount, 3);
  end
  else if ((Num < 0.0) and (buff[iLen + 1] = '0')) or ((Num >= 0.0) and (buff[iLen] = '0')) then
  begin
    szNum^ := OtherWords[1];
    Inc(ResultCount);
  end;

  SetLength(Result, ResultCount);
end;

{$IFDEF MSWINDOWS}

function DevName: CommonString;
var
  A: array [0 .. 255] of TChar;
  n: longword;
begin
  A[0] := #0;
  n := SizeOf(A);
  GetComputerName(A, n);
  A[n] := #0;
  Result := A;
end;

{$ENDIF}
{$IFDEF LINUX}

function DevName: CommonString;
var
  un: utsname;
begin
  fpuname(un);
  DevName := un.NodeName;
end;
{$ENDIF}

function IsSubPath(path1, path2: CommonString): boolean;
begin
  Result := (path1 <> '') and (path2 <> '');
  if Result then
  begin
    path1 := LowerCase(path1);
    path2 := LowerCase(path2);
    if Length(path1) < Length(path2) then
      System.Delete(path2, Length(path1) + 1, Length(path2))
    else
      System.Delete(path1, Length(path2) + 1, Length(path1));
    DbgPrint('Path1 %s Path2 %s', [path1, path2], L_DBGLEVEL_RUNTIMEINFO);
    Result := path1 = path2;
  end;
end;

const
  STR_DATALEVEL: array [0 .. 5] of string = ('', 'K', 'M', 'G', 'T', 'P');

function DataToKMGP(d: int64): CommonString;
var
  dt: double;
  ll: integer;
begin
  Result := '';
  ll := 0;
  dt := d;
  while (dt / 1000 > 1) and (ll in [Low(STR_DATALEVEL) .. High(STR_DATALEVEL)]) do
  begin
    dt := dt / 1000;
    Inc(ll);
  end;
  Result := Format('%0.2f%s', [dt, STR_DATALEVEL[ll]]);
end;

{$IFDEF MSWINDOWS}

function GetDiskType(Disk: CommonString): longword;
var
  hDevice: THandle;
  pDevDesc: PSTORAGE_DEVICE_DESCRIPTOR;
  query: TSTORAGE_PROPERTY_QUERY;
  Header: TSTORAGE_DESCRIPTOR_HEADER;
  R: longword;
begin
  Result := DRIVE_UNKNOWN;
  if (Disk <> '') and (Disk[Length(Disk)] = PathDelim) then
    System.Delete(Disk, Length(Disk), 1);
  Disk := '\\.\' + Disk;
  hDevice := CreateFile(PCommonChar(Disk), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or
    FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if hDevice <> INVALID_HANDLE_VALUE then
  begin
    query.PropertyId := longword(StorageDeviceProperty);
    query.QueryType := longword(PropertyStandardQuery);
    if DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, @query, 12, @Header,
      SizeOf(TSTORAGE_DESCRIPTOR_HEADER), R, nil) then
    begin
      GetMem(pDevDesc, Header.size);
      if pDevDesc <> nil then
      begin
        if DeviceIoControl(hDevice, IOCTL_STORAGE_QUERY_PROPERTY, @query, 12, pDevDesc, Header.size, R, nil) then
        begin
          case TSTORAGE_BUS_TYPE(pDevDesc.BusType) of
            BusTypeScsi, BusTypeAtapi, BusTypeAta, BusType1394, BusTypeSsa, BusTypeFibre, BusTypeRAID, BusTypeiScsi,
            BusTypeSas, BusTypeSata, BusTypeSd, BusTypeMmc:
              Result := DRIVE_FIXED;
            BusTypeUsb:
              Result := DRIVE_REMOVABLE;
            else
              Result := DRIVE_UNKNOWN;
          end;
        end;
        FreeMem(pDevDesc);
      end;
    end
    else
      DbgPrintSysError('');
    FileClose(hDevice); { *转换从CloseHandle* }
  end
  else
    DbgPrintSysError('');
end;
{$ENDIF}

function CompareMem(P1, P2: Pointer; Len: longword): boolean;
var
  pint64_1: Pint64 absolute P1;
  pint64_2: Pint64 absolute P2;
  pint32_1: PInteger absolute P1;
  pint32_2: PInteger absolute P2;
  pword_1: PWord absolute P1;
  pword_2: PWord absolute P2;
  pbyte_1: pbyte absolute P1;
  pbyte_2: pbyte absolute P2;
begin
  Result := True;
  while Len > SizeOf(int64) do
  begin
    if pint64_1^ <> pint64_2^ then
    begin
      Result := False;
      Exit;
    end;
    Inc(pint64_1);
    Inc(pint64_2);
    Dec(Len, SizeOf(int64));
  end;
  if Len > SizeOf(integer) then
  begin
    if pint32_1^ <> pint32_2^ then
    begin
      Result := False;
      Exit;
    end;
    Inc(pint32_1);
    Inc(pint32_2);
    Dec(Len, SizeOf(integer));
  end;
  if Len > SizeOf(word) then
  begin
    if pword_1^ <> pword_2^ then
    begin
      Result := False;
      Exit;
    end;
    Inc(pword_1);
    Inc(pword_2);
    Dec(Len, SizeOf(word));
  end;
  if Len = SizeOf(byte) then
    Result := pbyte_1^ = pbyte_2^;
end;

function RegularExt(FileName: CommonString; ExpectExt: CommonString; ReservePath: boolean): CommonString;
var
  Path, mname, ename: CommonString;
begin
  DivFileName(FileName, Path, mname, ename);
  Result := mname + ename;
  if ename <> ExpectExt then
    Result := Result + ExpectExt;
  if ReservePath then
    Result := Path + Result;
end;

function FetchStr(var s: CommonString; DivC: widechar = '-'): CommonString;
var
  l: integer;
begin
  l := Pos(DivC, s);
  if l = 0 then
    l := Length(s) + 1;
  Result := Copy(s, 1, l - 1);
  System.Delete(s, 1, l);
end;

function StrToDate(s: CommonString): TDateTime;
var
  S1: CommonString;
  st: TCommonSysTime;
begin
  FillChar(st, SizeOf(st), 0);
  S1 := FetchStr(s);
  st.wYear := StrToInt(S1);
  S1 := FetchStr(s);
  st.wMonth := StrToInteger(S1);
  S1 := FetchStr(s);
  st.wDay := StrToInt(S1);
  Result := EncodeDate(st.wYear, st.wMonth, st.wDay);
end;

function StrToTime(s: CommonString): TDateTime;
var
  S1: CommonString;
  st: TCommonSysTime;
begin
  FillChar(st, SizeOf(st), 0);
  S1 := FetchStr(s, ':');
  st.wHour := StrToInt(S1);
  S1 := FetchStr(s, ':');
  st.wMinute := StrToInteger(S1);
  S1 := FetchStr(s, ':');
  st.wSecond := StrToInt(S1);
  Result := EncodeTime(st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
end;

function IsExcelFile(ExtName: CommonString): boolean;
const
  ExcelExt: array [0 .. 2] of string = ('.xls', '.xlsx', '.et');
var
  i: integer;
begin
  ExtName := LowerCase(ExtName);
  Result := False;
  for i := Low(ExcelExt) to High(ExcelExt) do
    if ExcelExt[i] = ExtName then
    begin
      Result := True;
      Break;
    end;
end;

function AnsiTrim(s: ansistring): ansistring;
var
  i, ie: integer;
begin
  i := 1;
  ie := Length(s);
  while i <= Length(s) do
  begin
    if (s[i] <> #9) and (s[i] <> ' ') then
      Break;
    Inc(i);
  end;
  if i = Length(s) + 1 then
  begin
    Result := '';
    Exit;
  end;
  while ie >= 1 do
  begin
    if (s[ie] <> #9) and (s[ie] <> ' ') then
      Break;
    Dec(ie);
  end;
  if i <= ie then
    Result := Copy(s, i, ie - i + 1)
  else
    Result := s;
end;

function AnsiLower(s: ansistring): ansistring;
var
  i: integer;
begin
  Result := s;
  for i := 1 to Length(Result) do
    if Result[i] in ['A' .. 'Z'] then
      Result[i] := ansichar(Ord(Result[i]) + Ord('a') - Ord('A'));
end;

function AnsiUpper(s: ansistring): ansistring;
var
  i: integer;
begin
  Result := s;
  for i := 1 to Length(Result) do
    if Result[i] in ['a' .. 'z'] then
      Result[i] := ansichar(Ord(Result[i]) + Ord('A') - Ord('a'));
end;

function FetchStrFromCode(var s: CommonString; var ct: TCODETYPE; var dt: TDIVTYPE): CommonString;

  procedure FetchToSpace;
  var
    i: integer;
  begin
    for i := 2 to Length(s) do
      if (s[i] = ' ') or (s[i] = #9) then
      begin
        Result := Copy(s, 1, i - 1);
        System.Delete(s, 1, i);
        dt := dtInterval;
        Exit;
      end;
    Result := s;
    s := '';
    dt := dtLineEnd;
  end;

  procedure FetchChar;
  var
    i: integer;
  begin
    for i := 2 to Length(s) do
    begin
      if (s[i] = ' ') or (s[i] = #9) then
      begin
        Result := Copy(s, 1, i - 1);
        System.Delete(s, 1, i);
        dt := dtInterval;
        Exit;
      end;
      if not CharInSet(s[i], S_CHARSET) and not CharInSet(s[i], S_NUMBERSET) then
      begin
        Result := Copy(s, 1, i - 1);
        System.Delete(s, 1, i - 1);
        dt := dtDiffType;
        Exit;
      end;
    end;
    Result := s;
    s := '';
    dt := dtLineEnd;
  end;

  procedure FetchToSpaceAndSymbol;
  var
    i: integer;
  begin
    for i := 2 to Length(s) do
    begin
      if (s[i] = ' ') or (s[i] = #9) then
      begin
        Result := Copy(s, 1, i - 1);
        System.Delete(s, 1, i);
        dt := dtInterval;
        Exit;
      end;
      if not CharInSet(s[i], S_SYMBOLSET) then
      begin
        Result := Copy(s, 1, i - 1);
        System.Delete(s, 1, i - 1);
        dt := dtDiffType;
        Exit;
      end;
    end;
    Result := s;
    s := '';
    dt := dtLineEnd;
  end;

  procedure FetchNum;
  var
    i: integer;
  begin
    for i := 2 to Length(s) do
    begin
      if (s[i] = ' ') or (s[i] = #9) then
      begin
        Result := Copy(s, 1, i - 1);
        System.Delete(s, 1, i);
        dt := dtInterval;
        Exit;
      end;
      if not CharInSet(s[i], S_NUMBERSET) then
      begin
        if (s[1] = '$') and not CharInSet(s[i], S_SYMBOLSET) then
        begin
          Result := s[1];
          System.Delete(s, 1, 1);
          ct := ctSymbolSet;
          dt := dtDiffType;
          Exit;
        end;
        Result := Copy(s, 1, i - 1);
        System.Delete(s, 1, i - 1);
        dt := dtDiffType;
        Exit;
      end;
    end;
    Result := s;
    s := '';
    dt := dtLineEnd;
  end;

begin
  dt := dtUnknown;
  s := Trim(s);
  Result := '';
  if s <> '' then
  begin
    case s[1] of
      'a' .. 'z', 'A' .. 'Z', '_':
        ct := ctCharSet;
      ':', '''', '"', '`', '~', '!', '@', '#', '%', '^', '&', '*', '(', ')', '-', '=', '+', '[', '{', ']', '}', '\',
      '|', ',', '<', '.', '>', '/', '?', ';':
        ct := ctSymbolSet;
      '0' .. '9', '$':
        ct := ctNumber;
      else
        ct := ctUnknown;
    end;
    case ct of
      ctUnknown:
        FetchToSpace;
      ctCharSet:
        FetchChar;
      ctSymbolSet:
        FetchToSpaceAndSymbol;
      ctNumber:
        FetchNum;
    end;
  end;
end;

function CurrentPath: CommonString;
  {$IFDEF MSWINDOWS}
var
  A: array [0 .. MAX_PATH] of widechar;
  {$ENDIF}
begin
  {$IFDEF MSWINDOWS}
  A[0] := #0;
  GetCurrentDirectoryW(MAX_PATH, A);
  Result := A;
  {$ELSE}
  Result := GetCurrentDir;
  {$ENDIF}
end;

function CheckIsChineseChar(s: CommonString): boolean;
begin
  Result := (s <> '') and ((word(s[1]) >= $4E00) and (word(s[1]) <= $9FA5));
end;

function CheckIsID(s: CommonString): boolean;
var
  S1: string;
  i: integer;
begin
  Result := Length(s) = 18;
  if Result then
  begin
    S1 := Copy(s, 7, 2);
    Result := (S1 = '19') or (S1 = '20');
    if Result then
    begin
      for i := 1 to 17 do
      begin
        Result := (Ord(s[i]) >= Ord('0')) and (Ord(s[i]) <= Ord('9'));
        if not Result then
          Exit;
      end;
      Result := (Ord(s[18]) >= Ord('0')) and (Ord(s[18]) <= Ord('9')) or (s[18] = 'x') or (s[18] = 'X');
    end;
  end;
end;

function CheckIsMobileNum(s: CommonString): boolean;
var
  i: integer;
begin
  Result := Length(s) = 11;
  for i := 1 to Length(s) do
    if (s[i] < '0') or (s[i] > '9') then
    begin
      Result := False;
      Exit;
    end;
end;

function IsLeapYear(year: integer): boolean;
begin
  if year mod 4 = 0 then
  begin
    if year mod 100 = 0 then
      Result := year mod 400 = 0
    else
      Result := True;
  end
  else
    Result := False;
end;

function AnalyFileName(FullName: CommonString; var Driver: commonchar;
  var Path, MainName, ExtName: CommonString): boolean;
var
  step, P: integer;
begin
  Driver := #0;
  Path := '';
  MainName := '';
  ExtName := '';
  step := 0;
  while FullName <> '' do
  begin
    case step of
      0:
      begin
        if (Length(FullName) > 1) and (FullName[2] = DriveDelim) then
        begin
          Driver := FullName[1];
          System.Delete(FullName, 1, 2);
        end;
        Inc(step);
      end;
      1:
      begin
        for P := Length(FullName) downto 1 do
          if FullName[P] = PathDelim then
          begin
            Path := Copy(FullName, 1, P);
            System.Delete(FullName, 1, P);
            Break;
          end;
        Inc(step);
      end;
      2:
      begin
        for P := Length(FullName) downto 1 do
          if FullName[P] = '.' then
          begin
            ExtName := Copy(FullName, P + 1, Length(FullName));
            System.Delete(FullName, P, Length(FullName));
            MainName := FullName;
            FullName := '';
            Break;
          end;
        if FullName <> '' then
        begin
          MainName := FullName;
          FullName := '';
        end;
        Inc(step);
      end;
    end;
  end;
  Result := (Driver <> #0) and (Path <> '') and (MainName <> '') and (ExtName <> '');
end;

function CombineFileName(Driver: commonchar; Path, MainName, ExtName: CommonString): CommonString;
begin
  if Driver <> '' then
    Result := Driver + DriveDelim
  else
    Result := '';
  if Path <> '' then
  begin
    Result := Result + Path;
    if Path[Length(Path)] <> PathDelim then
      Result := Result + PathDelim;
  end;
  if ExtName <> '' then
    Result := Result + MainName + '.' + ExtName
  else
    Result := Result + MainName;
end;

function UCSToUTF8(ucs: longword): rawbytestring;
begin
  case ucs of
    0 .. $7F:
      Result := ansichar(ucs);
    $80 .. $7FF:
      Result := ansichar($C0 + (ucs shr 6)) + ansichar($80 + (ucs and $3F));
    $800 .. $FFFF:
      Result := ansichar($E0 + (ucs shr 12)) + ansichar($80 + ((ucs shr 6) and $3F)) + ansichar($80 + (ucs and $3F));
    $10000 .. $1FFFFF:
      Result := ansichar($F0 + (ucs shr 17)) + ansichar($80 + ((ucs shr 11) and $3F)) +
        ansichar($80 + ((ucs shr 5) and $3F)) + ansichar($80 + (ucs and $3F));
    $200000 .. $3FFFFFF:
      Result := ansichar($F8 + (ucs shr 25)) + ansichar($80 + ((ucs shr 19) and $3F)) +
        ansichar($80 + ((ucs shr 13) and $3F)) + ansichar($80 + ((ucs shr 5) and $3F)) + ansichar($80 + (ucs and $3F));
    $4000000 .. $7FFFFFFF:
      Result := ansichar($FC + (ucs shr 30)) + ansichar($80 + ((ucs shr 24) and $3F)) +
        ansichar($80 + ((ucs shr 18) and $3F)) + ansichar($80 + ((ucs shr 12) and $3F)) +
        ansichar($80 + ((ucs shr 6) and $3F)) + ansichar($80 + (ucs and $3F));
  end;
end;

function UnicodeStrToUTF8(s: unicodestring): rawbytestring;
var
  i: integer;
begin
  Result := '';
  for i := 1 to Length(s) do
    Result := Result + UCSToUTF8(word(s[i]));
end;

function UTF8StrToUnicode(s: rawbytestring): unicodestring;
var
  ucs: longword;
  c: widechar absolute ucs;
  i: integer;
  pa: pbyte;
begin
  Result := '';
  if s <> '' then
  begin
    pa := pbyte(s);
    i := 0;
    while pa^ <> 0 do
    begin
      if pa^ and $80 = 0 then
        Result := Result + widechar(pa^)
      else
      begin
        if pa^ and $C0 = $80 then
        begin
          ucs := ucs shl 6;
          ucs := ucs + pa^ and $3F;
          Dec(i);
          if i = 0 then
            Result := Result + c;
        end
        else
        begin
          if pa^ and $E0 = $C0 then
          begin
            i := 1;
            ucs := pa^ and $1F;
          end
          else if pa^ and $F0 = $E0 then
          begin
            i := 2;
            ucs := pa^ and $F;
          end
          else if pa^ and $F8 = $F0 then
          begin
            i := 3;
            ucs := pa^ and 7;
          end
          else if pa^ and $FC = $F8 then
          begin
            i := 4;
            ucs := pa^ and 3;
          end
          else if pa^ and $FE = $FC then
          begin
            i := 5;
            ucs := pa^ and 1;
          end;
        end;
      end;
      Inc(pa);
    end;
  end;
end;

function SecondToDT(Sec: longword): CommonString;
begin
  Result := IntToStr(Sec mod 60) + '秒';
  Sec := Sec div 60;
  if Sec > 0 then
  begin
    Result := IntToStr(Sec mod 60) + '分' + Result;
    Sec := Sec div 60;
    if Sec > 0 then
    begin
      Result := IntToStr(Sec mod 24) + '时' + Result;
      Sec := Sec div 24;
      if Sec > 0 then
        Result := IntToStr(Sec) + '天' + Result;
    end;
  end;
end;

function RegularPath(s: CommonString): CommonString;
begin
  if (s <> '') and (s[Length(s)] <> PathDelim) then
    Result := s + PathDelim
  else
    Result := s;
end;

function RegularStr(s: CommonString): CommonString;
var
  i: integer;
begin
  Result := Trim(s);
  i := Length(Result);
  while i > 0 do
    if Result[i] = ' ' then
      System.Delete(Result, i, 1)
    else
      Dec(i);
end;

function DeleteComment(s: CommonString): CommonString;
var
  i: integer;
begin
  i := Pos('#', s);
  if i = 0 then
    i := Pos('//', s);
  if i <> 0 then
    Result := Copy(s, 1, i - 1)
  else
    Result := s;
  Result := Trim(Result);
end;

{$IFDEF FPC}
{$ASMMODE intel}
{$ENDIF}

{$IFDEF MSWINDOWS}
function GetCPUID: TCPUID;
asm
         {$IF Defined(CPUX86)}
  push  ebx
  push  edi
  mov   edi, eax
  mov   eax, 1
  dw    $A20F
  stosd
  mov   eax, ebx
  stosd
  mov   eax, ecx
  stosd
  mov   eax, edx
  stosd
  pop   edi
  pop   ebx
         {$ELSEIF Defined(CPUX64)}
  push RBX
  push RDI
  MOV RDI, RCX
  MOV  EAX, 1
  CPUID
  mov [RDI], EAX
  mov [RDI + 4], EBX
  mov [RDI + 8], ECX
  mov [RDI + 12], EDX
  POP RDI
  POP RBX
         {$IFEND}
end;
{$ENDIF}

function GenCPUSerialNo: CommonString;
var
  i: TCPUID;
  h: THASH_VAL;
begin
//  Androidapi.AppGlue
  i := GetCPUID;
  h := GetHash(i, SizeOf(i));
  Result := h.ToString;
end;

procedure ByteToHexStr(b: byte; P: PCommonChar);
var
  t: byte;
begin
  t := b shr 4;
  if t > 9 then
    P^ := C_HEX_NUMBER[t - 10]
  else
    P^ := C_NUMBER[t];
  Inc(P);
  t := b and 15;
  if t > 9 then
    P^ := C_HEX_NUMBER[t - 10]
  else
    P^ := C_NUMBER[t];
end;

procedure InitDbgName;
var
  s: CommonString;
begin
  s := ExeFileName;
  AppName := ExtractFileMainName(s);
  s := ModuleFileName;
  s := ExtractFileMainName(s);
  if AppName = s then
    MDLName := ''
  else
    MDLName := s;
end;

{$R-}
{$Q-}

function BufCheckSum(const Buf; Len: longword): longword;
var
  pl: PLongword;
  Pc: pbyte absolute pl;
begin
  Result := 0;
  pl := PLongword(@Buf);
  while Len > 0 do
    if Len >= SizeOf(longword) then
    begin
      Inc(Result, pl^);
      Inc(pl);
      Dec(Len, SizeOf(longword));
    end
    else
    begin
      Inc(Result, Pc^);
      Inc(Pc);
      Dec(Len);
    end;
end;

procedure SetFileModTime(FileName: CommonString; mt: TFILETIME);
var
  {$IFDEF MSWINDOWS}
  h: THandle;
  {$ELSE}
  st: stat;
  tms: UtimBuf;
  {$ENDIF}
begin
  {$IFDEF MSWINDOWS}
  h := FileOpen(FileName, fmOpenWrite);
  if h <> INVALID_HANDLE_VALUE then
  begin
    SetFileTime(h, nil, nil, @mt);
    FileClose(h);
  end;
  {$ELSE}
  if fpstat(FileName, st) = 0 then
  begin
    tms.actime := st.st_atime;
    tms.ModTime := Pint64(@mt)^;
    fputime(FileName, @tms);
  end;
  {$ENDIF}
end;

procedure CreateMemFile(FileName: CommonString; size: longword; var Handle: THandle; var P: Pointer);
{$IFDEF MSWINDOWS}
var
  sa: SECURITY_ATTRIBUTES;
  pSD: Windows.PSECURITY_DESCRIPTOR;
begin
  Handle := INVALID_HANDLE_VALUE;
  P := nil;
  pSD := Windows.PSECURITY_DESCRIPTOR(LocalAlloc(LPTR, SECURITY_DESCRIPTOR_MIN_LENGTH));
  if InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION) then
    if SetSecurityDescriptorDacl(pSD, True, nil, False) then
    begin
      sa.nLength := SizeOf(sa);
      sa.lpSecurityDescriptor := pSD;
      sa.bInheritHandle := False;
      Handle := CreateFileMapping(INVALID_HANDLE_VALUE, @sa, PAGE_READWRITE, 0, size, PCommonChar(FileName));
      if Handle <> INVALID_HANDLE_VALUE then
        P := MapViewOfFile(Handle, FILE_MAP_ALL_ACCESS, 0, 0, size);
    end;
  if Handle = INVALID_HANDLE_VALUE then
    LocalFree(HLOCAL(pSD));
{$ELSE}
begin

{$ENDIF}
end;

procedure OpenMemFile(FileName: CommonString; size: longword; var Handle: THandle; var P: Pointer);
begin
  P := nil;
  {$IFDEF MSWINDOWS}
  Handle := OpenFileMapping(PAGE_READWRITE, False, PCommonChar(FileName));
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    P := MapViewOfFile(Handle, FILE_MAP_ALL_ACCESS, 0, 0, size);
    if P = nil then
      DbgPrintSysError('Open mem file ' + FileName + ' failed:');
  end;
  {$ELSE}
  {$ENDIF}
end;

procedure FreeMemFile(var Handle: THandle; var P: Pointer);
begin
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    {$IFDEF MSWINDOWS}
    UnMapViewOfFile(P);
    {$ELSE}
    {$ENDIF}
    P := nil;
    FileClose(Handle); { *转换从CloseHandle* }
    Handle := INVALID_HANDLE_VALUE;
  end;
end;

procedure GetFileInfo(FileName: CommonString; var FileSize: TFILE_SIZE; var Hash: THASH_VAL; var ModTime: TFILETIME);
var
  h: THandle;
  Buf: Pointer;
  R: longword;
  {$IFDEF LINUX}
  st: stat;
  {$ENDIF}
  {$IFDEF FPC}
  MD5: TMD5Context;
  md5r: TMD5Digest absolute Hash;
  {$ELSE}
  MD5: THashMD5;
  {$ENDIF}
begin
  FillChar(Hash, SizeOf(Hash), 0);
  FileSize.fp64 := 0;
  h := FileOpen(FileName, fmOpenRead);
  if h <> INVALID_HANDLE_VALUE then
  begin
    {$IFDEF MSWINDOWS}
    FileSize.fpLow := Windows.GetFileSize(h, @FileSize.fpHigh);
    GetFileTime(h, nil, nil, @ModTime);
    {$ELSE}
    FillChar(st, SizeOf(st), 0);
    if fpstat(FileName, st) = 0 then
    begin
      FileSize.fp64 := st.st_size;
      Pint64(@ModTime)^ := st.st_mtime;
    end
    else
    begin
      FileSize.fp64 := 0;
      ModTime.dwLowDateTime := 0;
      ModTime.dwHighDateTime := 0;
    end;
    {$ENDIF}
    GetMem(Buf, HASHDATA_BUF_SIZE);
    if Buf <> nil then
    begin
      {$IFDEF FPC}
      MD5Init(MD5);
      {$ELSE}
      MD5.Reset;
      {$ENDIF}
      while True do
      begin
        R := FileRead(h, Buf^, HASHDATA_BUF_SIZE);
        if R > 0 then
        {$IFDEF FPC}
          MD5Update(MD5, Buf^, R)
          {$ELSE}
          MD5.Update(Buf^, R)
        {$ENDIF}
        else
          Break;
      end;
    end;
    {$IFDEF FPC}
    MD5Final(MD5, md5r);
    {$ELSE}
    Hash.CopyFromBytes(MD5.HashAsBytes);
    {$ENDIF}
    FileClose(h); { *转换从CloseHandle* }
    FreeMem(Buf);
  end;
end;

procedure GetNetCardInfos(var ni: TNETCARDINFOS);
{$IFDEF MSWINDOWS}
const
  L_WORKBUFSIZE = 15 * 1024;
var
  flags: longword;
  ipaddrs, pip: PIP_ADAPTER_ADDRESSES;
  puni: PIP_ADAPTER_UNICAST_ADDRESS;
  obl, R: longword;
begin
  SetLength(ni, 0);
  GetMem(ipaddrs, L_WORKBUFSIZE);
  if ipaddrs <> nil then
  begin
    flags := GAA_FLAG_INCLUDE_PREFIX // 返回IPV4&#43;IPV6
      or GAA_FLAG_SKIP_DNS_SERVER // 不用返回DSN
      or GAA_FLAG_SKIP_MULTICAST // 不用返回多播地址
      or GAA_FLAG_SKIP_ANYCAST;
    obl := L_WORKBUFSIZE;
    R := GetAdaptersAddresses(AF_UNSPEC, flags, nil, ipaddrs, @obl);
    if R = NO_ERROR then
    begin
      pip := ipaddrs;
      while pip <> nil do
      begin
        obl := Length(ni);
        SetLength(ni, obl + 1);
        ni[obl].Name := CommonString(pip.AdapterName);
        ni[obl].Desc := pip.Description;
        puni := pip.FirstUnicastAddress;
        while puni <> nil do
        begin
          if puni.Address.lpSockaddr.sa_family = AF_INET then
            ni[obl].IPV4 := PSockAddrIn(puni.Address.lpSockaddr).sin_addr.s_addr;
          puni := puni.Next;
        end;
        pip := pip.Next;
      end;
    end;
    FreeMem(ipaddrs);
  end;
end;
{$ELSE}

begin
end;
{$ENDIF}

function MoveFile(old, new: CommonString): longword;
begin
  Result := 1;
  if LowerCase(old) <> LowerCase(new) then
  begin
    {$IFDEF MSWINDOWS}
    if LowerCase(old[1]) = LowerCase(new[1]) then
    begin
      DeleteFile(PCommonChar(new));
      if RenameFile(old, new) then
        Result := NOERROR
      else
        Result := GetLastError;
    end
    else
    begin
      SysUtils.DeleteFile(new);
      if CopyFile(PCommonChar(old), PCommonChar(new), True) then
      begin
        if DeleteFile(PCommonChar(old)) then
          Result := 0;
      end;
    end;
    {$ELSE}
    {$ENDIF}
  end;
end;

{$IFDEF MSWINDOWS}

function IsX64: boolean;
var
  sio: SYSTEM_INFO;
begin
  FillChar(sio, SizeOf(sio), 0);
  GetNativeSystemInfo(sio);
  Result := (sio.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64) or
    (sio.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_IA64);
end;
{$ENDIF}

function ReplaceParam(var s: CommonString; Name, Value: CommonString): integer;
var
  P: integer;
  sl: CommonString;
begin
  Result := 0;
  while Name <> '' do
  begin
    sl := LowerCase(s);
    P := Pos(Name, sl);
    if P <> 0 then
    begin
      sl := Copy(s, 1, P - 1);
      System.Delete(s, 1, P + Length(Name) - 1);
      s := sl + Value + s;
    end
    else
      Break;
  end;
end;

function StringFromClipboardFormat(cf: word; AndNumber: boolean): CommonString;
var
  sz: array [0 .. 300] of char;
begin
  { Check if the data is one of the basic clipboard formats }
  {$IFDEF MSWINDOWS}
  case cf of
    CF_DIF:
      Result := 'CF_DIF';
    CF_DIB:
      Result := 'CF_DIB';
    CF_TEXT:
      Result := 'CF_TEXT';
    CF_SYLK:
      Result := 'CF_SYLK';
    CF_TIFF:
      Result := 'CF_TIFF';
    CF_RIFF:
      Result := 'CF_RIFF';
    CF_WAVE:
      Result := 'CF_WAVE';
    CF_HDROP:
      Result := 'CF_HDROP';
    CF_BITMAP:
      Result := 'CF_BITMAP';
    CF_LOCALE:
      Result := 'CF_LOCALE';
    CF_OEMTEXT:
      Result := 'CF_OEMTEXT';
    CF_PALETTE:
      Result := 'CF_PALETTE';
    CF_PENDATA:
      Result := 'CF_PENDATA';
    CF_UNICODETEXT:
      Result := 'CF_UNICODETEXT';
    CF_ENHMETAFILE:
      Result := 'CF_ENHMETAFILE';
    CF_METAFILEPICT:
      Result := 'CF_METAFILEPICT';
    else
    begin
      { Data type not found,so get the description for this data type }
      GetClipboardFormatName(cf, @sz, 200);
      { Add the numeric value of the item? }
      if AndNumber then
        Result := '[' + IntToStr(cf) + ']' + sz
      else
        Result := sz;
    end;
  end;
  {$ELSE}
  Result := '';
  {$ENDIF}
end;

function CheckStrType(s: CommonString; var Protocol, Domain, Port, Path, FileName: CommonString): TSTR_TYPE;
var
  i: integer;
begin
  i := Pos('://', s);
  if i <> 0 then
  begin
    Result := stURL;
    Protocol := Trim(Copy(s, 1, i - 1));
    System.Delete(s, 1, i + 2);
    s := Trim(s);
    i := Pos('/', s);
    if i = 0 then
      i := Length(s) + 1;
    Domain := Copy(s, 1, i - 1);
    System.Delete(s, 1, i);
    if s <> '' then
    begin
      Path := s;
      FileName := '';
      for i := Length(s) downto 1 do
        if s[i] = '/' then
        begin
          Path := Copy(s, 1, i);
          FileName := Copy(s, i + 1, Length(s));
          Result := stURI;
          Break;
        end;
    end;
    i := Pos(':', Domain);
    if i <> 0 then
    begin
      Port := Copy(Domain, i + 1, Length(Domain));
      System.Delete(Domain, i, Length(Domain));
    end;
  end
  else
    Result := stUnknown;
end;

initialization

  InitDbgName;

end.
